/[guile]/guile/guile-core/test-suite/tests/syntax.test
ViewVC logotype

Diff of /guile/guile-core/test-suite/tests/syntax.test

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.14 by dirk, Mon Sep 22 19:00:41 2003 UTC revision 1.15 by dirk, Tue Oct 7 22:00:05 2003 UTC
# Line 40  Line 40 
40    
41  (with-test-prefix "expressions"  (with-test-prefix "expressions"
42    
43      (with-test-prefix "Bad argument list"
44    
45        (pass-if-exception "improper argument list of length 1"
46          exception:wrong-num-args
47          (eval '(let ((foo (lambda (x y) #t)))
48                   (foo . 1))
49                (interaction-environment)))
50    
51        (pass-if-exception "improper argument list of length 2"
52          exception:wrong-num-args
53          (eval '(let ((foo (lambda (x y) #t)))
54                   (foo 1 . 2))
55                (interaction-environment))))
56    
57    (with-test-prefix "missing or extra expression"    (with-test-prefix "missing or extra expression"
58    
59      ;; R5RS says:      ;; R5RS says:
# Line 51  Line 65 
65      ;; Fixed on 2001-3-3      ;; Fixed on 2001-3-3
66      (pass-if-exception "empty parentheses \"()\""      (pass-if-exception "empty parentheses \"()\""
67        exception:missing/extra-expr        exception:missing/extra-expr
68        ())))        (eval '()
69                (interaction-environment)))))
70    
71  (with-test-prefix "quote"  (with-test-prefix "quote"
72    #t)    #t)
# Line 87  Line 102 
102    
103      (pass-if-exception "(lambda)"      (pass-if-exception "(lambda)"
104        exception:bad-formals        exception:bad-formals
105        (lambda))        (eval '(lambda)
106                (interaction-environment)))
107    
108      (pass-if-exception "(lambda . \"foo\")"      (pass-if-exception "(lambda . \"foo\")"
109        exception:bad-formals        exception:bad-formals
110        (lambda . "foo"))        (eval '(lambda . "foo")
111                (interaction-environment)))
112    
113      (pass-if-exception "(lambda \"foo\")"      (pass-if-exception "(lambda \"foo\")"
114        exception:bad-formals        exception:bad-formals
115        (lambda "foo"))        (eval '(lambda "foo")
116                (interaction-environment)))
117    
118      (pass-if-exception "(lambda \"foo\" #f)"      (pass-if-exception "(lambda \"foo\" #f)"
119        exception:bad-formals        exception:bad-formals
# Line 104  Line 122 
122    
123      (pass-if-exception "(lambda (x 1) 2)"      (pass-if-exception "(lambda (x 1) 2)"
124        exception:bad-formals        exception:bad-formals
125        (lambda (x 1) 2))        (eval '(lambda (x 1) 2)
126                (interaction-environment)))
127    
128      (pass-if-exception "(lambda (1 x) 2)"      (pass-if-exception "(lambda (1 x) 2)"
129        exception:bad-formals        exception:bad-formals
130        (lambda (1 x) 2))        (eval '(lambda (1 x) 2)
131                (interaction-environment)))
132    
133      (pass-if-exception "(lambda (x \"a\") 2)"      (pass-if-exception "(lambda (x \"a\") 2)"
134        exception:bad-formals        exception:bad-formals
135        (lambda (x "a") 2))        (eval '(lambda (x "a") 2)
136                (interaction-environment)))
137    
138      (pass-if-exception "(lambda (\"a\" x) 2)"      (pass-if-exception "(lambda (\"a\" x) 2)"
139        exception:bad-formals        exception:bad-formals
140        (lambda ("a" x) 2)))        (eval '(lambda ("a" x) 2)
141                (interaction-environment))))
142    
143    (with-test-prefix "duplicate formals"    (with-test-prefix "duplicate formals"
144    
145      ;; Fixed on 2001-3-3      ;; Fixed on 2001-3-3
146      (pass-if-exception "(lambda (x x) 1)"      (pass-if-exception "(lambda (x x) 1)"
147        exception:duplicate-formals        exception:duplicate-formals
148        (lambda (x x) 1))        (eval '(lambda (x x) 1)
149                (interaction-environment)))
150    
151      ;; Fixed on 2001-3-3      ;; Fixed on 2001-3-3
152      (pass-if-exception "(lambda (x x x) 1)"      (pass-if-exception "(lambda (x x x) 1)"
153        exception:duplicate-formals        exception:duplicate-formals
154        (lambda (x x x) 1)))        (eval '(lambda (x x x) 1)
155                (interaction-environment))))
156    
157    (with-test-prefix "bad body"    (with-test-prefix "bad body"
158    
159      (pass-if-exception "(lambda ())"      (pass-if-exception "(lambda ())"
160        exception:bad-body        exception:bad-body
161        (lambda ()))))        (eval '(lambda ())
162                (interaction-environment)))))
163    
164  (with-test-prefix "let"  (with-test-prefix "let"
165    
# Line 148  Line 173 
173    
174      (pass-if-exception "(let)"      (pass-if-exception "(let)"
175        exception:bad-bindings        exception:bad-bindings
176        (let))        (eval '(let)
177                (interaction-environment)))
178    
179      (pass-if-exception "(let 1)"      (pass-if-exception "(let 1)"
180        exception:bad-bindings        exception:bad-bindings
181        (let 1))        (eval '(let 1)
182                (interaction-environment)))
183    
184      (pass-if-exception "(let (x))"      (pass-if-exception "(let (x))"
185        exception:bad-bindings        exception:bad-bindings
186        (let (x)))        (eval '(let (x))
187                (interaction-environment)))
188    
189      ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?      ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
190      ;; (Even although the body is bad as well...)      ;; (Even although the body is bad as well...)
191      (pass-if-exception "(let ((x)))"      (pass-if-exception "(let ((x)))"
192        exception:bad-body        exception:bad-body
193        (let ((x))))        (eval '(let ((x)))
194                (interaction-environment)))
195    
196      (pass-if-exception "(let (x) 1)"      (pass-if-exception "(let (x) 1)"
197        exception:bad-bindings        exception:bad-bindings
198        (let (x) 1))        (eval '(let (x) 1)
199                (interaction-environment)))
200    
201      (pass-if-exception "(let ((x)) 3)"      (pass-if-exception "(let ((x)) 3)"
202        exception:bad-bindings        exception:bad-bindings
203        (let ((x)) 3))        (eval '(let ((x)) 3)
204                (interaction-environment)))
205    
206      (pass-if-exception "(let ((x 1) y) x)"      (pass-if-exception "(let ((x 1) y) x)"
207        exception:bad-bindings        exception:bad-bindings
208        (let ((x 1) y) x))        (eval '(let ((x 1) y) x)
209                (interaction-environment)))
210    
211      (pass-if-exception "(let ((1 2)) 3)"      (pass-if-exception "(let ((1 2)) 3)"
212        exception:bad-var        exception:bad-var
# Line 185  Line 217 
217    
218      (pass-if-exception "(let ((x 1) (x 2)) x)"      (pass-if-exception "(let ((x 1) (x 2)) x)"
219        exception:duplicate-bindings        exception:duplicate-bindings
220        (let ((x 1) (x 2)) x)))        (eval '(let ((x 1) (x 2)) x)
221                (interaction-environment))))
222    
223    (with-test-prefix "bad body"    (with-test-prefix "bad body"
224    
225      (pass-if-exception "(let ())"      (pass-if-exception "(let ())"
226        exception:bad-body        exception:bad-body
227        (let ()))        (eval '(let ())
228                (interaction-environment)))
229    
230      (pass-if-exception "(let ((x 1)))"      (pass-if-exception "(let ((x 1)))"
231        exception:bad-body        exception:bad-body
232        (let ((x 1))))))        (eval '(let ((x 1)))
233                (interaction-environment)))))
234    
235  (with-test-prefix "named let"  (with-test-prefix "named let"
236    
# Line 209  Line 244 
244    
245      (pass-if-exception "(let x (y))"      (pass-if-exception "(let x (y))"
246        exception:bad-bindings        exception:bad-bindings
247        (let x (y))))        (eval '(let x (y))
248                (interaction-environment))))
249    
250    (with-test-prefix "bad body"    (with-test-prefix "bad body"
251    
252      (pass-if-exception "(let x ())"      (pass-if-exception "(let x ())"
253        exception:bad-body        exception:bad-body
254        (let x ()))        (eval '(let x ())
255                (interaction-environment)))
256    
257      (pass-if-exception "(let x ((y 1)))"      (pass-if-exception "(let x ((y 1)))"
258        exception:bad-body        exception:bad-body
259        (let x ((y 1))))))        (eval '(let x ((y 1)))
260                (interaction-environment)))))
261    
262  (with-test-prefix "let*"  (with-test-prefix "let*"
263    
# Line 237  Line 275 
275    
276      (pass-if-exception "(let*)"      (pass-if-exception "(let*)"
277        exception:bad-bindings        exception:bad-bindings
278        (let*))        (eval '(let*)
279                (interaction-environment)))
280    
281      (pass-if-exception "(let* 1)"      (pass-if-exception "(let* 1)"
282        exception:bad-bindings        exception:bad-bindings
283        (let* 1))        (eval '(let* 1)
284                (interaction-environment)))
285    
286      (pass-if-exception "(let* (x))"      (pass-if-exception "(let* (x))"
287        exception:bad-bindings        exception:bad-bindings
288        (let* (x)))        (eval '(let* (x))
289                (interaction-environment)))
290    
291      (pass-if-exception "(let* (x) 1)"      (pass-if-exception "(let* (x) 1)"
292        exception:bad-bindings        exception:bad-bindings
293        (let* (x) 1))        (eval '(let* (x) 1)
294                (interaction-environment)))
295    
296      (pass-if-exception "(let* ((x)) 3)"      (pass-if-exception "(let* ((x)) 3)"
297        exception:bad-bindings        exception:bad-bindings
298        (let* ((x)) 3))        (eval '(let* ((x)) 3)
299                (interaction-environment)))
300    
301      (pass-if-exception "(let* ((x 1) y) x)"      (pass-if-exception "(let* ((x 1) y) x)"
302        exception:bad-bindings        exception:bad-bindings
303        (let* ((x 1) y) x))        (eval '(let* ((x 1) y) x)
304                (interaction-environment)))
305    
306      (pass-if-exception "(let* x ())"      (pass-if-exception "(let* x ())"
307        exception:bad-bindings        exception:bad-bindings
# Line 278  Line 322 
322    
323      (pass-if-exception "(let* ())"      (pass-if-exception "(let* ())"
324        exception:bad-body        exception:bad-body
325        (let* ()))        (eval '(let* ())
326                (interaction-environment)))
327    
328      (pass-if-exception "(let* ((x 1)))"      (pass-if-exception "(let* ((x 1)))"
329        exception:bad-body        exception:bad-body
330        (let* ((x 1))))))        (eval '(let* ((x 1)))
331                (interaction-environment)))))
332    
333  (with-test-prefix "letrec"  (with-test-prefix "letrec"
334    
# Line 297  Line 343 
343    
344      (pass-if-exception "(letrec)"      (pass-if-exception "(letrec)"
345        exception:bad-bindings        exception:bad-bindings
346        (letrec))        (eval '(letrec)
347                (interaction-environment)))
348    
349      (pass-if-exception "(letrec 1)"      (pass-if-exception "(letrec 1)"
350        exception:bad-bindings        exception:bad-bindings
351        (letrec 1))        (eval '(letrec 1)
352                (interaction-environment)))
353    
354      (pass-if-exception "(letrec (x))"      (pass-if-exception "(letrec (x))"
355        exception:bad-bindings        exception:bad-bindings
356        (letrec (x)))        (eval '(letrec (x))
357                (interaction-environment)))
358    
359      (pass-if-exception "(letrec (x) 1)"      (pass-if-exception "(letrec (x) 1)"
360        exception:bad-bindings        exception:bad-bindings
361        (letrec (x) 1))        (eval '(letrec (x) 1)
362                (interaction-environment)))
363    
364      (pass-if-exception "(letrec ((x)) 3)"      (pass-if-exception "(letrec ((x)) 3)"
365        exception:bad-bindings        exception:bad-bindings
366        (letrec ((x)) 3))        (eval '(letrec ((x)) 3)
367                (interaction-environment)))
368    
369      (pass-if-exception "(letrec ((x 1) y) x)"      (pass-if-exception "(letrec ((x 1) y) x)"
370        exception:bad-bindings        exception:bad-bindings
371        (letrec ((x 1) y) x))        (eval '(letrec ((x 1) y) x)
372                (interaction-environment)))
373    
374      (pass-if-exception "(letrec x ())"      (pass-if-exception "(letrec x ())"
375        exception:bad-bindings        exception:bad-bindings
# Line 338  Line 390 
390    
391      (pass-if-exception "(letrec ((x 1) (x 2)) x)"      (pass-if-exception "(letrec ((x 1) (x 2)) x)"
392        exception:duplicate-bindings        exception:duplicate-bindings
393        (letrec ((x 1) (x 2)) x)))        (eval '(letrec ((x 1) (x 2)) x)
394                (interaction-environment))))
395    
396    (with-test-prefix "bad body"    (with-test-prefix "bad body"
397    
398      (pass-if-exception "(letrec ())"      (pass-if-exception "(letrec ())"
399        exception:bad-body        exception:bad-body
400        (letrec ()))        (eval '(letrec ())
401                (interaction-environment)))
402    
403      (pass-if-exception "(letrec ((x 1)))"      (pass-if-exception "(letrec ((x 1)))"
404        exception:bad-body        exception:bad-body
405        (letrec ((x 1))))))        (eval '(letrec ((x 1)))
406                (interaction-environment)))))
407    
408  (with-test-prefix "if"  (with-test-prefix "if"
409    
# Line 370  Line 425 
425    
426      (pass-if-exception "(cond)"      (pass-if-exception "(cond)"
427        exception:bad/missing-clauses        exception:bad/missing-clauses
428        (cond))        (eval '(cond)
429                (interaction-environment)))
430    
431      (pass-if-exception "(cond #t)"      (pass-if-exception "(cond #t)"
432        exception:bad/missing-clauses        exception:bad/missing-clauses
433        (cond #t))        (eval '(cond #t)
434                (interaction-environment)))
435    
436      (pass-if-exception "(cond 1)"      (pass-if-exception "(cond 1)"
437        exception:bad/missing-clauses        exception:bad/missing-clauses
438        (cond 1))        (eval '(cond 1)
439                (interaction-environment)))
440    
441      (pass-if-exception "(cond 1 2)"      (pass-if-exception "(cond 1 2)"
442        exception:bad/missing-clauses        exception:bad/missing-clauses
443        (cond 1 2))        (eval '(cond 1 2)
444                (interaction-environment)))
445    
446      (pass-if-exception "(cond 1 2 3)"      (pass-if-exception "(cond 1 2 3)"
447        exception:bad/missing-clauses        exception:bad/missing-clauses
448        (cond 1 2 3))        (eval '(cond 1 2 3)
449                (interaction-environment)))
450    
451      (pass-if-exception "(cond 1 2 3 4)"      (pass-if-exception "(cond 1 2 3 4)"
452        exception:bad/missing-clauses        exception:bad/missing-clauses
453        (cond 1 2 3 4))        (eval '(cond 1 2 3 4)
454                (interaction-environment)))
455    
456      (pass-if-exception "(cond ())"      (pass-if-exception "(cond ())"
457        exception:bad/missing-clauses        exception:bad/missing-clauses
458        (cond ()))        (eval '(cond ())
459                (interaction-environment)))
460    
461      (pass-if-exception "(cond () 1)"      (pass-if-exception "(cond () 1)"
462        exception:bad/missing-clauses        exception:bad/missing-clauses
463        (cond () 1))        (eval '(cond () 1)
464                (interaction-environment)))
465    
466      (pass-if-exception "(cond (1) 1)"      (pass-if-exception "(cond (1) 1)"
467        exception:bad/missing-clauses        exception:bad/missing-clauses
468        (cond (1) 1))))        (eval '(cond (1) 1)
469                (interaction-environment)))))
470    
471  (with-test-prefix "cond =>"  (with-test-prefix "cond =>"
472    
473      (with-test-prefix "cond is hygienic"
474    
475        (expect-fail "bound '=> is handled correctly"
476          (false-if-exception
477           (eq? (let ((=> #f)) (cond (#t => 'ok))) 'ok))))
478    
479    (with-test-prefix "else is handled correctly"    (with-test-prefix "else is handled correctly"
480    
481      (pass-if "else =>"      (pass-if "else =>"
# Line 416  Line 486 
486        (let* ((=> 'foo))        (let* ((=> 'foo))
487          (eq? (cond (else => identity)) identity))))          (eq? (cond (else => identity)) identity))))
488    
489    (with-test-prefix "bad formals"    (with-test-prefix "wrong number of arguments"
490    
491      (pass-if-exception "=> (lambda (x 1) 2)"      (pass-if-exception "=> (lambda (x y) #t)"
492        exception:bad-formals        exception:wrong-num-args
493        (cond (1 => (lambda (x 1) 2))))))        (cond (1 => (lambda (x y) #t))))))
494    
495  (with-test-prefix "case"  (with-test-prefix "case"
496    
# Line 428  Line 498 
498    
499      (pass-if-exception "(case)"      (pass-if-exception "(case)"
500        exception:bad/missing-clauses        exception:bad/missing-clauses
501        (case))        (eval '(case)
502                (interaction-environment)))
503    
504      (pass-if-exception "(case . \"foo\")"      (pass-if-exception "(case . \"foo\")"
505        exception:bad/missing-clauses        exception:bad/missing-clauses
506        (case . "foo"))        (eval '(case . "foo")
507                (interaction-environment)))
508    
509      (pass-if-exception "(case 1)"      (pass-if-exception "(case 1)"
510        exception:bad/missing-clauses        exception:bad/missing-clauses
511        (case 1))        (eval '(case 1)
512                (interaction-environment)))
513    
514      (pass-if-exception "(case 1 . \"foo\")"      (pass-if-exception "(case 1 . \"foo\")"
515        exception:bad/missing-clauses        exception:bad/missing-clauses
516        (case 1 . "foo"))        (eval '(case 1 . "foo")
517                (interaction-environment)))
518    
519      (pass-if-exception "(case 1 \"foo\")"      (pass-if-exception "(case 1 \"foo\")"
520        exception:bad/missing-clauses        exception:bad/missing-clauses
521        (case 1 "foo"))        (eval '(case 1 "foo")
522                (interaction-environment)))
523    
524      (pass-if-exception "(case 1 ())"      (pass-if-exception "(case 1 ())"
525        exception:bad/missing-clauses        exception:bad/missing-clauses
526        (case 1 ()))        (eval '(case 1 ())
527                (interaction-environment)))
528    
529      (pass-if-exception "(case 1 (\"foo\"))"      (pass-if-exception "(case 1 (\"foo\"))"
530        exception:bad/missing-clauses        exception:bad/missing-clauses
531        (case 1 ("foo")))        (eval '(case 1 ("foo"))
532                (interaction-environment)))
533    
534      (pass-if-exception "(case 1 (\"foo\" \"bar\"))"      (pass-if-exception "(case 1 (\"foo\" \"bar\"))"
535        exception:bad/missing-clauses        exception:bad/missing-clauses
536        (case 1 ("foo" "bar")))        (eval '(case 1 ("foo" "bar"))
537                (interaction-environment)))
538    
539      ;; According to R5RS, the following one is syntactically correct.      ;; According to R5RS, the following one is syntactically correct.
540      ;; (pass-if-exception "(case 1 (() \"bar\"))"      ;; (pass-if-exception "(case 1 (() \"bar\"))"
# Line 465  Line 543 
543    
544      (pass-if-exception "(case 1 ((2) \"bar\") . \"foo\")"      (pass-if-exception "(case 1 ((2) \"bar\") . \"foo\")"
545        exception:bad/missing-clauses        exception:bad/missing-clauses
546        (case 1 ((2) "bar") . "foo"))        (eval '(case 1 ((2) "bar") . "foo")
547                (interaction-environment)))
548    
549      (pass-if-exception "(case 1 (else #f) ((1) #t))"      (pass-if-exception "(case 1 ((2) \"bar\") (else))"
550        exception:bad/missing-clauses        exception:bad/missing-clauses
551        (case 1 ((2) "bar") (else)))        (eval '(case 1 ((2) "bar") (else))
552                (interaction-environment)))
553    
554      (pass-if-exception "(case 1 (else #f) . \"foo\")"      (pass-if-exception "(case 1 (else #f) . \"foo\")"
555        exception:bad/missing-clauses        exception:bad/missing-clauses
556        (case 1 (else #f) . "foo"))        (eval '(case 1 (else #f) . "foo")
557                (interaction-environment)))
558    
559      (pass-if-exception "(case 1 (else #f) ((1) #t))"      (pass-if-exception "(case 1 (else #f) ((1) #t))"
560        exception:bad/missing-clauses        exception:bad/missing-clauses
561        (case 1 (else #f) ((1) #t)))))        (eval '(case 1 (else #f) ((1) #t))
562                (interaction-environment)))))
563    
564  (with-test-prefix "define"  (with-test-prefix "define"
565    
# Line 491  Line 573 
573    
574      (pass-if-exception "(define)"      (pass-if-exception "(define)"
575        exception:missing/extra-expr        exception:missing/extra-expr
576        (define))))        (eval '(define)
577                (interaction-environment)))))
578    
579  (with-test-prefix "set!"  (with-test-prefix "set!"
580    
# Line 558  Line 641 
641    (define (unreachable)    (define (unreachable)
642      (error "unreachable code has been reached!"))      (error "unreachable code has been reached!"))
643        
   ;; an environment with no bindings at all  
   (define empty-environment  
     (make-module 1))  
     
644    ;; Return a new procedure COND which when called (COND) will return #t the    ;; Return a new procedure COND which when called (COND) will return #t the
645    ;; first N times, then #f, then any further call is an error.  N=0 is    ;; first N times, then #f, then any further call is an error.  N=0 is
646    ;; allowed, in which case #f is returned by the first call.    ;; allowed, in which case #f is returned by the first call.
# Line 578  Line 657 
657        
658    
659    (pass-if-exception "too few args" exception:wrong-num-args    (pass-if-exception "too few args" exception:wrong-num-args
660      (while))      (eval '(while) (interaction-environment)))
661        
662    (with-test-prefix "empty body"    (with-test-prefix "empty body"
663      (do ((n 0 (1+ n)))      (do ((n 0 (1+ n)))
# Line 594  Line 673 
673      #t)      #t)
674        
675    (with-test-prefix "in empty environment"    (with-test-prefix "in empty environment"
676        
677        ;; an environment with no bindings at all
678        (define empty-environment
679          (make-module 1))
680          
681      (pass-if "empty body"      (pass-if "empty body"
682        (eval `(,while #f)        (eval `(,while #f)
683              empty-environment)              empty-environment)

Legend:
Removed from v.1.14  
changed lines
  Added in v.1.15

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26