Commit | Line | Data |
---|---|---|
141443d7 | 1 | ;;;; eval.test --- tests guile's evaluator -*- scheme -*- |
96e30d2a | 2 | ;;;; Copyright (C) 2000, 2001 Free Software Foundation, Inc. |
141443d7 | 3 | ;;;; |
73be1d9e MV |
4 | ;;;; This library is free software; you can redistribute it and/or |
5 | ;;;; modify it under the terms of the GNU Lesser General Public | |
6 | ;;;; License as published by the Free Software Foundation; either | |
7 | ;;;; version 2.1 of the License, or (at your option) any later version. | |
8 | ;;;; | |
9 | ;;;; This library is distributed in the hope that it will be useful, | |
141443d7 | 10 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
73be1d9e MV |
11 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
12 | ;;;; Lesser General Public License for more details. | |
13 | ;;;; | |
14 | ;;;; You should have received a copy of the GNU Lesser General Public | |
15 | ;;;; License along with this library; if not, write to the Free Software | |
92205699 | 16 | ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA |
141443d7 | 17 | |
d6e04e7c DH |
18 | (define-module (test-suite test-eval) |
19 | :use-module (test-suite lib) | |
20 | :use-module (ice-9 documentation)) | |
141443d7 DH |
21 | |
22 | ||
62360b89 DH |
23 | (define exception:bad-expression |
24 | (cons 'syntax-error "Bad expression")) | |
25 | ||
26 | ||
141443d7 DH |
27 | ;;; |
28 | ;;; miscellaneous | |
29 | ;;; | |
30 | ||
141443d7 | 31 | (define (documented? object) |
5c96bc39 | 32 | (not (not (object-documentation object)))) |
141443d7 DH |
33 | |
34 | ||
35 | ;;; | |
62360b89 | 36 | ;;; memoization |
141443d7 DH |
37 | ;;; |
38 | ||
62360b89 DH |
39 | (with-test-prefix "memoization" |
40 | ||
41 | (with-test-prefix "copy-tree" | |
42 | ||
43 | (pass-if "(#t . #(#t))" | |
44 | (let* ((foo (cons #t (vector #t))) | |
45 | (bar (copy-tree foo))) | |
46 | (vector-set! (cdr foo) 0 #f) | |
47 | (equal? bar '(#t . #(#t))))) | |
48 | ||
49 | (pass-if-exception "circular lists in forms" | |
50 | exception:bad-expression | |
51 | (let ((foo (list #f))) | |
52 | (set-cdr! foo foo) | |
53 | (copy-tree foo)))) | |
141443d7 | 54 | |
62360b89 DH |
55 | (pass-if "transparency" |
56 | (let ((x '(begin 1))) | |
57 | (eval x (current-module)) | |
58 | (equal? '(begin 1) x)))) | |
414959ca | 59 | |
62360b89 DH |
60 | |
61 | ;;; | |
62 | ;;; eval | |
63 | ;;; | |
64 | ||
65 | (with-test-prefix "evaluator" | |
414959ca | 66 | |
08c608e1 DH |
67 | (with-test-prefix "symbol lookup" |
68 | ||
69 | (with-test-prefix "top level" | |
70 | ||
71 | (with-test-prefix "unbound" | |
72 | ||
73 | (pass-if-exception "variable reference" | |
74 | exception:unbound-var | |
75 | x) | |
76 | ||
77 | (pass-if-exception "procedure" | |
78 | exception:unbound-var | |
79 | (x))))) | |
80 | ||
141443d7 DH |
81 | (with-test-prefix "parameter error" |
82 | ||
83 | ;; This is currently a bug in guile: | |
84 | ;; Macros are accepted as function parameters. | |
85 | ;; Functions that 'apply' macros are rewritten!!! | |
86 | ||
6b4113af DH |
87 | (expect-fail-exception "macro as argument" |
88 | exception:wrong-type-arg | |
141443d7 | 89 | (let ((f (lambda (p a b) (p a b)))) |
6b4113af DH |
90 | (f and #t #t))) |
91 | ||
92 | (expect-fail-exception "passing macro as parameter" | |
93 | exception:wrong-type-arg | |
94 | (let* ((f (lambda (p a b) (p a b))) | |
95 | (foo (procedure-source f))) | |
96 | (f and #t #t) | |
97 | (equal? (procedure-source f) foo))) | |
141443d7 DH |
98 | |
99 | )) | |
100 | ||
08c608e1 DH |
101 | ;;; |
102 | ;;; apply | |
103 | ;;; | |
104 | ||
105 | (with-test-prefix "application" | |
106 | ||
107 | (with-test-prefix "wrong number of arguments" | |
108 | ||
109 | (pass-if-exception "((lambda () #f) 1)" | |
110 | exception:wrong-num-args | |
111 | ((lambda () #f) 1)) | |
112 | ||
113 | (pass-if-exception "((lambda (x) #f))" | |
114 | exception:wrong-num-args | |
115 | ((lambda (x) #f))) | |
116 | ||
117 | (pass-if-exception "((lambda (x) #f) 1 2)" | |
118 | exception:wrong-num-args | |
119 | ((lambda (x) #f) 1 2)) | |
120 | ||
121 | (pass-if-exception "((lambda (x y) #f))" | |
122 | exception:wrong-num-args | |
123 | ((lambda (x y) #f))) | |
124 | ||
125 | (pass-if-exception "((lambda (x y) #f) 1)" | |
126 | exception:wrong-num-args | |
127 | ((lambda (x y) #f) 1)) | |
128 | ||
129 | (pass-if-exception "((lambda (x y) #f) 1 2 3)" | |
130 | exception:wrong-num-args | |
131 | ((lambda (x y) #f) 1 2 3)) | |
132 | ||
133 | (pass-if-exception "((lambda (x . rest) #f))" | |
134 | exception:wrong-num-args | |
135 | ((lambda (x . rest) #f))) | |
136 | ||
137 | (pass-if-exception "((lambda (x y . rest) #f))" | |
138 | exception:wrong-num-args | |
139 | ((lambda (x y . rest) #f))) | |
140 | ||
141 | (pass-if-exception "((lambda (x y . rest) #f) 1)" | |
142 | exception:wrong-num-args | |
143 | ((lambda (x y . rest) #f) 1)))) | |
144 | ||
141443d7 DH |
145 | ;;; |
146 | ;;; map | |
147 | ;;; | |
148 | ||
149 | (with-test-prefix "map" | |
150 | ||
151 | ;; Is documentation available? | |
152 | ||
153 | (expect-fail "documented?" | |
6ad9007a | 154 | (documented? map)) |
141443d7 DH |
155 | |
156 | (with-test-prefix "argument error" | |
157 | ||
158 | (with-test-prefix "non list argument" | |
159 | #t) | |
160 | ||
161 | (with-test-prefix "different length lists" | |
162 | ||
6b4113af DH |
163 | (pass-if-exception "first list empty" |
164 | exception:out-of-range | |
165 | (map + '() '(1))) | |
166 | ||
167 | (pass-if-exception "second list empty" | |
168 | exception:out-of-range | |
169 | (map + '(1) '())) | |
170 | ||
171 | (pass-if-exception "first list shorter" | |
172 | exception:out-of-range | |
173 | (map + '(1) '(2 3))) | |
174 | ||
175 | (pass-if-exception "second list shorter" | |
176 | exception:out-of-range | |
177 | (map + '(1 2) '(3))) | |
141443d7 | 178 | ))) |
414959ca | 179 | |
2b6b5908 DH |
180 | ;;; |
181 | ;;; promises | |
182 | ;;; | |
183 | ||
184 | (with-test-prefix "promises" | |
185 | ||
186 | (with-test-prefix "basic promise behaviour" | |
187 | ||
188 | (pass-if "delay gives a promise" | |
189 | (promise? (delay 1))) | |
190 | ||
191 | (pass-if "force evaluates a promise" | |
192 | (eqv? (force (delay (+ 1 2))) 3)) | |
193 | ||
194 | (pass-if "a forced promise is a promise" | |
195 | (let ((p (delay (+ 1 2)))) | |
196 | (force p) | |
197 | (promise? p))) | |
198 | ||
199 | (pass-if "forcing a forced promise works" | |
200 | (let ((p (delay (+ 1 2)))) | |
201 | (force p) | |
202 | (eqv? (force p) 3))) | |
203 | ||
204 | (pass-if "a promise is evaluated once" | |
205 | (let* ((x 1) | |
206 | (p (delay (+ x 1)))) | |
207 | (force p) | |
208 | (set! x (+ x 1)) | |
209 | (eqv? (force p) 2))) | |
210 | ||
211 | (pass-if "a promise may call itself" | |
212 | (define p | |
213 | (let ((x 0)) | |
214 | (delay | |
215 | (begin | |
216 | (set! x (+ x 1)) | |
217 | (if (> x 1) x (force p)))))) | |
218 | (eqv? (force p) 2)) | |
219 | ||
220 | (pass-if "a promise carries its environment" | |
221 | (let* ((x 1) (p #f)) | |
222 | (let* ((x 2)) | |
223 | (set! p (delay (+ x 1)))) | |
224 | (eqv? (force p) 3))) | |
225 | ||
226 | (pass-if "a forced promise does not reference its environment" | |
227 | (let* ((g (make-guardian)) | |
228 | (p #f)) | |
229 | (let* ((x (cons #f #f))) | |
230 | (g x) | |
231 | (set! p (delay (car x)))) | |
232 | (force p) | |
233 | (gc) | |
234 | (if (not (equal? (g) (cons #f #f))) | |
235 | (throw 'unresolved) | |
236 | #t)))) | |
237 | ||
238 | (with-test-prefix "extended promise behaviour" | |
239 | ||
240 | (pass-if-exception "forcing a non-promise object is not supported" | |
241 | exception:wrong-type-arg | |
242 | (force 1)) | |
243 | ||
244 | (pass-if-exception "implicit forcing is not supported" | |
245 | exception:wrong-type-arg | |
246 | (+ (delay (* 3 7)) 13)))) | |
247 | ||
d2797644 NJ |
248 | ;;; |
249 | ;;; letrec init evaluation | |
250 | ;;; | |
251 | ||
252 | (with-test-prefix "letrec init evaluation" | |
253 | ||
254 | (pass-if "lots of inits calculated in correct order" | |
255 | (equal? (letrec ((a 'a) (b 'b) (c 'c) (d 'd) | |
256 | (e 'e) (f 'f) (g 'g) (h 'h) | |
257 | (i 'i) (j 'j) (k 'k) (l 'l) | |
258 | (m 'm) (n 'n) (o 'o) (p 'p) | |
259 | (q 'q) (r 'r) (s 's) (t 't) | |
260 | (u 'u) (v 'v) (w 'w) (x 'x) | |
261 | (y 'y) (z 'z)) | |
262 | (list a b c d e f g h i j k l m | |
263 | n o p q r s t u v w x y z)) | |
264 | '(a b c d e f g h i j k l m | |
265 | n o p q r s t u v w x y z)))) | |
266 | ||
4f2ec3be | 267 | |
414959ca | 268 | ;;; eval.test ends here |