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 | |
16 | ;;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA | |
141443d7 DH |
17 | |
18 | (use-modules (ice-9 documentation)) | |
19 | ||
20 | ||
21 | ;;; | |
22 | ;;; miscellaneous | |
23 | ;;; | |
24 | ||
141443d7 | 25 | (define (documented? object) |
5c96bc39 | 26 | (not (not (object-documentation object)))) |
141443d7 DH |
27 | |
28 | ||
29 | ;;; | |
30 | ;;; eval | |
31 | ;;; | |
32 | ||
33 | (with-test-prefix "evaluator" | |
34 | ||
414959ca TTN |
35 | (with-test-prefix "memoization" |
36 | ||
37 | (pass-if "transparency" | |
38 | (let ((x '(begin 1))) | |
39 | (eval x (current-module)) | |
40 | (equal? '(begin 1) x)))) | |
41 | ||
08c608e1 DH |
42 | (with-test-prefix "symbol lookup" |
43 | ||
44 | (with-test-prefix "top level" | |
45 | ||
46 | (with-test-prefix "unbound" | |
47 | ||
48 | (pass-if-exception "variable reference" | |
49 | exception:unbound-var | |
50 | x) | |
51 | ||
52 | (pass-if-exception "procedure" | |
53 | exception:unbound-var | |
54 | (x))))) | |
55 | ||
141443d7 DH |
56 | (with-test-prefix "parameter error" |
57 | ||
58 | ;; This is currently a bug in guile: | |
59 | ;; Macros are accepted as function parameters. | |
60 | ;; Functions that 'apply' macros are rewritten!!! | |
61 | ||
6b4113af DH |
62 | (expect-fail-exception "macro as argument" |
63 | exception:wrong-type-arg | |
141443d7 | 64 | (let ((f (lambda (p a b) (p a b)))) |
6b4113af DH |
65 | (f and #t #t))) |
66 | ||
67 | (expect-fail-exception "passing macro as parameter" | |
68 | exception:wrong-type-arg | |
69 | (let* ((f (lambda (p a b) (p a b))) | |
70 | (foo (procedure-source f))) | |
71 | (f and #t #t) | |
72 | (equal? (procedure-source f) foo))) | |
141443d7 DH |
73 | |
74 | )) | |
75 | ||
08c608e1 DH |
76 | ;;; |
77 | ;;; apply | |
78 | ;;; | |
79 | ||
80 | (with-test-prefix "application" | |
81 | ||
82 | (with-test-prefix "wrong number of arguments" | |
83 | ||
84 | (pass-if-exception "((lambda () #f) 1)" | |
85 | exception:wrong-num-args | |
86 | ((lambda () #f) 1)) | |
87 | ||
88 | (pass-if-exception "((lambda (x) #f))" | |
89 | exception:wrong-num-args | |
90 | ((lambda (x) #f))) | |
91 | ||
92 | (pass-if-exception "((lambda (x) #f) 1 2)" | |
93 | exception:wrong-num-args | |
94 | ((lambda (x) #f) 1 2)) | |
95 | ||
96 | (pass-if-exception "((lambda (x y) #f))" | |
97 | exception:wrong-num-args | |
98 | ((lambda (x y) #f))) | |
99 | ||
100 | (pass-if-exception "((lambda (x y) #f) 1)" | |
101 | exception:wrong-num-args | |
102 | ((lambda (x y) #f) 1)) | |
103 | ||
104 | (pass-if-exception "((lambda (x y) #f) 1 2 3)" | |
105 | exception:wrong-num-args | |
106 | ((lambda (x y) #f) 1 2 3)) | |
107 | ||
108 | (pass-if-exception "((lambda (x . rest) #f))" | |
109 | exception:wrong-num-args | |
110 | ((lambda (x . rest) #f))) | |
111 | ||
112 | (pass-if-exception "((lambda (x y . rest) #f))" | |
113 | exception:wrong-num-args | |
114 | ((lambda (x y . rest) #f))) | |
115 | ||
116 | (pass-if-exception "((lambda (x y . rest) #f) 1)" | |
117 | exception:wrong-num-args | |
118 | ((lambda (x y . rest) #f) 1)))) | |
119 | ||
141443d7 DH |
120 | ;;; |
121 | ;;; map | |
122 | ;;; | |
123 | ||
124 | (with-test-prefix "map" | |
125 | ||
126 | ;; Is documentation available? | |
127 | ||
128 | (expect-fail "documented?" | |
6ad9007a | 129 | (documented? map)) |
141443d7 DH |
130 | |
131 | (with-test-prefix "argument error" | |
132 | ||
133 | (with-test-prefix "non list argument" | |
134 | #t) | |
135 | ||
136 | (with-test-prefix "different length lists" | |
137 | ||
6b4113af DH |
138 | (pass-if-exception "first list empty" |
139 | exception:out-of-range | |
140 | (map + '() '(1))) | |
141 | ||
142 | (pass-if-exception "second list empty" | |
143 | exception:out-of-range | |
144 | (map + '(1) '())) | |
145 | ||
146 | (pass-if-exception "first list shorter" | |
147 | exception:out-of-range | |
148 | (map + '(1) '(2 3))) | |
149 | ||
150 | (pass-if-exception "second list shorter" | |
151 | exception:out-of-range | |
152 | (map + '(1 2) '(3))) | |
141443d7 | 153 | ))) |
414959ca | 154 | |
2b6b5908 DH |
155 | ;;; |
156 | ;;; promises | |
157 | ;;; | |
158 | ||
159 | (with-test-prefix "promises" | |
160 | ||
161 | (with-test-prefix "basic promise behaviour" | |
162 | ||
163 | (pass-if "delay gives a promise" | |
164 | (promise? (delay 1))) | |
165 | ||
166 | (pass-if "force evaluates a promise" | |
167 | (eqv? (force (delay (+ 1 2))) 3)) | |
168 | ||
169 | (pass-if "a forced promise is a promise" | |
170 | (let ((p (delay (+ 1 2)))) | |
171 | (force p) | |
172 | (promise? p))) | |
173 | ||
174 | (pass-if "forcing a forced promise works" | |
175 | (let ((p (delay (+ 1 2)))) | |
176 | (force p) | |
177 | (eqv? (force p) 3))) | |
178 | ||
179 | (pass-if "a promise is evaluated once" | |
180 | (let* ((x 1) | |
181 | (p (delay (+ x 1)))) | |
182 | (force p) | |
183 | (set! x (+ x 1)) | |
184 | (eqv? (force p) 2))) | |
185 | ||
186 | (pass-if "a promise may call itself" | |
187 | (define p | |
188 | (let ((x 0)) | |
189 | (delay | |
190 | (begin | |
191 | (set! x (+ x 1)) | |
192 | (if (> x 1) x (force p)))))) | |
193 | (eqv? (force p) 2)) | |
194 | ||
195 | (pass-if "a promise carries its environment" | |
196 | (let* ((x 1) (p #f)) | |
197 | (let* ((x 2)) | |
198 | (set! p (delay (+ x 1)))) | |
199 | (eqv? (force p) 3))) | |
200 | ||
201 | (pass-if "a forced promise does not reference its environment" | |
202 | (let* ((g (make-guardian)) | |
203 | (p #f)) | |
204 | (let* ((x (cons #f #f))) | |
205 | (g x) | |
206 | (set! p (delay (car x)))) | |
207 | (force p) | |
208 | (gc) | |
209 | (if (not (equal? (g) (cons #f #f))) | |
210 | (throw 'unresolved) | |
211 | #t)))) | |
212 | ||
213 | (with-test-prefix "extended promise behaviour" | |
214 | ||
215 | (pass-if-exception "forcing a non-promise object is not supported" | |
216 | exception:wrong-type-arg | |
217 | (force 1)) | |
218 | ||
219 | (pass-if-exception "implicit forcing is not supported" | |
220 | exception:wrong-type-arg | |
221 | (+ (delay (* 3 7)) 13)))) | |
222 | ||
414959ca | 223 | ;;; eval.test ends here |