1 ;;;; syntax.test --- test suite for Guile's syntactic forms -*- scheme -*-
3 ;;;; Copyright (C) 2001, 2003, 2004, 2005, 2006, 2009, 2010,
4 ;;;; 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
6 ;;;; This library is free software; you can redistribute it and/or
7 ;;;; modify it under the terms of the GNU Lesser General Public
8 ;;;; License as published by the Free Software Foundation; either
9 ;;;; version 3 of the License, or (at your option) any later version.
11 ;;;; This library is distributed in the hope that it will be useful,
12 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 ;;;; Lesser General Public License for more details.
16 ;;;; You should have received a copy of the GNU Lesser General Public
17 ;;;; License along with this library; if not, write to the Free Software
18 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
20 (define-module (test-suite test-syntax)
21 #:use-module (ice-9 regex)
22 #:use-module (ice-9 local-eval)
23 #:use-module (test-suite lib))
26 (define exception:generic-syncase-error
27 "source expression failed to match")
28 (define exception:unexpected-syntax
31 (define exception:bad-expression
34 (define exception:missing/extra-expr
35 "Missing or extra expression")
36 (define exception:missing-expr
38 (define exception:missing-body-expr
39 "no expressions in body")
40 (define exception:extra-expr
42 (define exception:illegal-empty-combination
43 "Illegal empty combination")
45 (define exception:bad-lambda
47 (define exception:bad-let
49 (define exception:bad-letrec
51 (define exception:bad-letrec*
53 (define exception:bad-set!
55 (define exception:bad-quote
56 '(quote . "bad syntax"))
57 (define exception:bad-bindings
59 (define exception:bad-binding
61 (define exception:duplicate-binding
62 "duplicate bound variable")
63 (define exception:bad-body
65 (define exception:bad-formals
66 "invalid argument list")
67 (define exception:bad-formal
69 (define exception:duplicate-formals
70 "duplicate identifier in argument list")
72 (define exception:missing-clauses
74 (define exception:misplaced-else-clause
75 "Misplaced else clause")
76 (define exception:bad-case-clause
78 (define exception:bad-case-labels
80 (define exception:bad-cond-clause
83 (define exception:too-many-args
85 (define exception:wrong-number-of-values
86 '(wrong-number-of-args . "number of (values)|(arguments)"))
87 (define exception:zero-expression-sequence
88 "sequence of zero expressions")
91 ;; (put 'pass-if-syntax-error 'scheme-indent-function 1)
92 (define-syntax pass-if-syntax-error
97 (lambda () exp (error "expected syntax-error exception"))
98 (lambda (k who what where form . maybe-subform)
100 (and (eq? who (car pat))
101 (string-match (cdr pat) what))
102 (string-match pat what))
104 (error "unexpected syntax-error exception" what pat))))))))
106 (with-test-prefix "expressions"
108 (with-test-prefix "Bad argument list"
110 (pass-if-syntax-error "improper argument list of length 1"
111 exception:generic-syncase-error
112 (eval '(let ((foo (lambda (x y) #t)))
114 (interaction-environment)))
116 (pass-if-syntax-error "improper argument list of length 2"
117 exception:generic-syncase-error
118 (eval '(let ((foo (lambda (x y) #t)))
120 (interaction-environment))))
122 (with-test-prefix "missing or extra expression"
125 ;; *Note:* In many dialects of Lisp, the empty combination, (),
126 ;; is a legitimate expression. In Scheme, combinations must
127 ;; have at least one subexpression, so () is not a syntactically
131 (pass-if-syntax-error "empty parentheses \"()\""
132 exception:unexpected-syntax
134 (interaction-environment)))))
136 (with-test-prefix "quote"
139 (with-test-prefix "quasiquote"
141 (with-test-prefix "unquote"
143 (pass-if "repeated execution"
144 (let ((foo (let ((i 0)) (lambda () (set! i (+ i 1)) `(,i)))))
145 (and (equal? (foo) '(1)) (equal? (foo) '(2))))))
147 (with-test-prefix "unquote-splicing"
149 (pass-if "extra arguments"
150 (equal? (eval '(quasiquote ((unquote-splicing (list 1 2) (list 3 4))))
151 (interaction-environment))
154 (with-test-prefix "begin"
156 (pass-if "valid (begin)"
157 (eval '(begin (begin) #t) (interaction-environment)))
159 (if (not (include-deprecated-features))
160 (pass-if-syntax-error "invalid (begin)"
161 exception:zero-expression-sequence
162 (eval '(begin (if #t (begin)) #t) (interaction-environment)))))
164 (define-syntax matches?
166 ((_ (op arg ...) pat) (let ((x (op arg ...)))
169 ((_ x (a . b)) (and (pair? x)
171 (matches? (cdr x) b)))
173 ((_ x pat) (equal? x 'pat))))
175 (with-test-prefix "lambda"
177 (with-test-prefix "bad formals"
179 (pass-if-syntax-error "(lambda)"
182 (interaction-environment)))
184 (pass-if-syntax-error "(lambda . \"foo\")"
186 (eval '(lambda . "foo")
187 (interaction-environment)))
189 (pass-if-syntax-error "(lambda \"foo\")"
191 (eval '(lambda "foo")
192 (interaction-environment)))
194 (pass-if-syntax-error "(lambda \"foo\" #f)"
195 exception:bad-formals
196 (eval '(lambda "foo" #f)
197 (interaction-environment)))
199 (pass-if-syntax-error "(lambda (x 1) 2)"
200 exception:bad-formals
201 (eval '(lambda (x 1) 2)
202 (interaction-environment)))
204 (pass-if-syntax-error "(lambda (1 x) 2)"
205 exception:bad-formals
206 (eval '(lambda (1 x) 2)
207 (interaction-environment)))
209 (pass-if-syntax-error "(lambda (x \"a\") 2)"
210 exception:bad-formals
211 (eval '(lambda (x "a") 2)
212 (interaction-environment)))
214 (pass-if-syntax-error "(lambda (\"a\" x) 2)"
215 exception:bad-formals
216 (eval '(lambda ("a" x) 2)
217 (interaction-environment))))
219 (with-test-prefix "duplicate formals"
222 (pass-if-syntax-error "(lambda (x x) 1)"
223 exception:duplicate-formals
224 (eval '(lambda (x x) 1)
225 (interaction-environment)))
228 (pass-if-syntax-error "(lambda (x x x) 1)"
229 exception:duplicate-formals
230 (eval '(lambda (x x x) 1)
231 (interaction-environment))))
233 (with-test-prefix "bad body"
235 (pass-if-syntax-error "(lambda ())"
238 (interaction-environment)))))
240 (with-test-prefix "let"
242 (with-test-prefix "bindings"
244 (pass-if-exception "late binding"
245 exception:unbound-var
246 (let ((x 1) (y x)) y)))
248 (with-test-prefix "bad bindings"
250 (pass-if-syntax-error "(let)"
253 (interaction-environment)))
255 (pass-if-syntax-error "(let 1)"
258 (interaction-environment)))
260 (pass-if-syntax-error "(let (x))"
263 (interaction-environment)))
265 (pass-if-syntax-error "(let ((x)))"
268 (interaction-environment)))
270 (pass-if-syntax-error "(let (x) 1)"
273 (interaction-environment)))
275 (pass-if-syntax-error "(let ((x)) 3)"
278 (interaction-environment)))
280 (pass-if-syntax-error "(let ((x 1) y) x)"
282 (eval '(let ((x 1) y) x)
283 (interaction-environment)))
285 (pass-if-syntax-error "(let ((1 2)) 3)"
287 (eval '(let ((1 2)) 3)
288 (interaction-environment))))
290 (with-test-prefix "duplicate bindings"
292 (pass-if-syntax-error "(let ((x 1) (x 2)) x)"
293 exception:duplicate-binding
294 (eval '(let ((x 1) (x 2)) x)
295 (interaction-environment))))
297 (with-test-prefix "bad body"
299 (pass-if-syntax-error "(let ())"
302 (interaction-environment)))
304 (pass-if-syntax-error "(let ((x 1)))"
307 (interaction-environment)))))
309 (with-test-prefix "named let"
311 (with-test-prefix "initializers"
313 (pass-if "evaluated in outer environment"
315 (eqv? (let f ((n (f 1))) n) -1))))
317 (with-test-prefix "bad bindings"
319 (pass-if-syntax-error "(let x (y))"
322 (interaction-environment))))
324 (with-test-prefix "bad body"
326 (pass-if-syntax-error "(let x ())"
329 (interaction-environment)))
331 (pass-if-syntax-error "(let x ((y 1)))"
333 (eval '(let x ((y 1)))
334 (interaction-environment)))))
336 (with-test-prefix "let*"
338 (with-test-prefix "bindings"
340 (pass-if "(let* ((x 1) (x 2)) ...)"
344 (pass-if "(let* ((x 1) (x x)) ...)"
348 (pass-if "(let ((x 1) (y 2)) (let* () ...))"
351 (and (= x 1) (= y 2))))))
353 (with-test-prefix "bad bindings"
355 (pass-if-syntax-error "(let*)"
356 exception:generic-syncase-error
358 (interaction-environment)))
360 (pass-if-syntax-error "(let* 1)"
361 exception:generic-syncase-error
363 (interaction-environment)))
365 (pass-if-syntax-error "(let* (x))"
366 exception:generic-syncase-error
368 (interaction-environment)))
370 (pass-if-syntax-error "(let* (x) 1)"
371 exception:generic-syncase-error
373 (interaction-environment)))
375 (pass-if-syntax-error "(let* ((x)) 3)"
376 exception:generic-syncase-error
377 (eval '(let* ((x)) 3)
378 (interaction-environment)))
380 (pass-if-syntax-error "(let* ((x 1) y) x)"
381 exception:generic-syncase-error
382 (eval '(let* ((x 1) y) x)
383 (interaction-environment)))
385 (pass-if-syntax-error "(let* x ())"
386 exception:generic-syncase-error
388 (interaction-environment)))
390 (pass-if-syntax-error "(let* x (y))"
391 exception:generic-syncase-error
393 (interaction-environment)))
395 (pass-if-syntax-error "(let* ((1 2)) 3)"
396 exception:generic-syncase-error
397 (eval '(let* ((1 2)) 3)
398 (interaction-environment))))
400 (with-test-prefix "bad body"
402 (pass-if-syntax-error "(let* ())"
403 exception:generic-syncase-error
405 (interaction-environment)))
407 (pass-if-syntax-error "(let* ((x 1)))"
408 exception:generic-syncase-error
409 (eval '(let* ((x 1)))
410 (interaction-environment)))))
412 (with-test-prefix "letrec"
414 (with-test-prefix "bindings"
416 (pass-if-syntax-error "initial bindings are undefined"
417 exception:used-before-defined
419 ;; FIXME: the memoizer does initialize the var to undefined, but
420 ;; the Scheme evaluator has no way of checking what's an
421 ;; undefined value. Not sure how to do this.
423 (letrec ((x 1) (y x)) y))))
425 (with-test-prefix "bad bindings"
427 (pass-if-syntax-error "(letrec)"
430 (interaction-environment)))
432 (pass-if-syntax-error "(letrec 1)"
435 (interaction-environment)))
437 (pass-if-syntax-error "(letrec (x))"
440 (interaction-environment)))
442 (pass-if-syntax-error "(letrec (x) 1)"
444 (eval '(letrec (x) 1)
445 (interaction-environment)))
447 (pass-if-syntax-error "(letrec ((x)) 3)"
449 (eval '(letrec ((x)) 3)
450 (interaction-environment)))
452 (pass-if-syntax-error "(letrec ((x 1) y) x)"
454 (eval '(letrec ((x 1) y) x)
455 (interaction-environment)))
457 (pass-if-syntax-error "(letrec x ())"
460 (interaction-environment)))
462 (pass-if-syntax-error "(letrec x (y))"
464 (eval '(letrec x (y))
465 (interaction-environment)))
467 (pass-if-syntax-error "(letrec ((1 2)) 3)"
469 (eval '(letrec ((1 2)) 3)
470 (interaction-environment))))
472 (with-test-prefix "duplicate bindings"
474 (pass-if-syntax-error "(letrec ((x 1) (x 2)) x)"
475 exception:duplicate-binding
476 (eval '(letrec ((x 1) (x 2)) x)
477 (interaction-environment))))
479 (with-test-prefix "bad body"
481 (pass-if-syntax-error "(letrec ())"
484 (interaction-environment)))
486 (pass-if-syntax-error "(letrec ((x 1)))"
488 (eval '(letrec ((x 1)))
489 (interaction-environment)))))
491 (with-test-prefix "letrec*"
493 (with-test-prefix "bindings"
495 (pass-if-syntax-error "initial bindings are undefined"
496 exception:used-before-defined
498 ;; FIXME: the memoizer does initialize the var to undefined, but
499 ;; the Scheme evaluator has no way of checking what's an
500 ;; undefined value. Not sure how to do this.
502 (letrec* ((x y) (y 1)) y))))
504 (with-test-prefix "bad bindings"
506 (pass-if-syntax-error "(letrec*)"
507 exception:bad-letrec*
509 (interaction-environment)))
511 (pass-if-syntax-error "(letrec* 1)"
512 exception:bad-letrec*
514 (interaction-environment)))
516 (pass-if-syntax-error "(letrec* (x))"
517 exception:bad-letrec*
519 (interaction-environment)))
521 (pass-if-syntax-error "(letrec* (x) 1)"
522 exception:bad-letrec*
523 (eval '(letrec* (x) 1)
524 (interaction-environment)))
526 (pass-if-syntax-error "(letrec* ((x)) 3)"
527 exception:bad-letrec*
528 (eval '(letrec* ((x)) 3)
529 (interaction-environment)))
531 (pass-if-syntax-error "(letrec* ((x 1) y) x)"
532 exception:bad-letrec*
533 (eval '(letrec* ((x 1) y) x)
534 (interaction-environment)))
536 (pass-if-syntax-error "(letrec* x ())"
537 exception:bad-letrec*
538 (eval '(letrec* x ())
539 (interaction-environment)))
541 (pass-if-syntax-error "(letrec* x (y))"
542 exception:bad-letrec*
543 (eval '(letrec* x (y))
544 (interaction-environment)))
546 (pass-if-syntax-error "(letrec* ((1 2)) 3)"
547 exception:bad-letrec*
548 (eval '(letrec* ((1 2)) 3)
549 (interaction-environment))))
551 (with-test-prefix "duplicate bindings"
553 (pass-if-syntax-error "(letrec* ((x 1) (x 2)) x)"
554 exception:duplicate-binding
555 (eval '(letrec* ((x 1) (x 2)) x)
556 (interaction-environment))))
558 (with-test-prefix "bad body"
560 (pass-if-syntax-error "(letrec* ())"
561 exception:bad-letrec*
563 (interaction-environment)))
565 (pass-if-syntax-error "(letrec* ((x 1)))"
566 exception:bad-letrec*
567 (eval '(letrec* ((x 1)))
568 (interaction-environment))))
570 (with-test-prefix "referencing previous values"
571 (pass-if (equal? (letrec ((a (cons 'foo 'bar))
575 (pass-if (equal? (let ()
576 (define a (cons 'foo 'bar))
581 (with-test-prefix "if"
583 (with-test-prefix "missing or extra expressions"
585 (pass-if-syntax-error "(if)"
586 exception:generic-syncase-error
588 (interaction-environment)))
590 (pass-if-syntax-error "(if 1 2 3 4)"
591 exception:generic-syncase-error
593 (interaction-environment)))))
595 (with-test-prefix "cond"
597 (with-test-prefix "cond is hygienic"
599 (pass-if "bound 'else is handled correctly"
600 (eq? (let ((else 'ok)) (cond (else))) 'ok))
602 (with-test-prefix "bound '=> is handled correctly"
606 (eq? (cond (#t => 'ok)) 'ok)))
610 (eq? (cond (else =>)) 'foo)))
612 (pass-if "else => identity"
614 (eq? (cond (else => identity)) identity)))))
616 (with-test-prefix "SRFI-61"
618 (pass-if "always available"
619 (cond-expand (srfi-61 #t) (else #f)))
621 (pass-if "single value consequent"
622 (eq? 'ok (cond (#t identity => (lambda (x) 'ok)) (else #f))))
624 (pass-if "single value alternate"
625 (eq? 'ok (cond (#t not => (lambda (x) #f)) (else 'ok))))
627 (pass-if-exception "doesn't affect standard =>"
628 exception:wrong-num-args
629 (cond ((values 1 2) => (lambda (x y) #t))))
631 (pass-if "multiple values consequent"
632 (equal? '(2 1) (cond ((values 1 2)
634 (and (= 1 one) (= 2 two))) =>
635 (lambda (one two) (list two one)))
638 (pass-if "multiple values alternate"
639 (eq? 'ok (cond ((values 2 3 4)
640 (lambda args (equal? '(1 2 3) args)) =>
644 (pass-if "zero values"
645 (eq? 'ok (cond ((values) (lambda () #t) => (lambda () 'ok))
648 (pass-if "bound => is handled correctly"
650 (eq? 'ok (cond (#t identity =>) (else #f)))))
652 (pass-if-syntax-error "missing recipient"
653 '(cond . "wrong number of receiver expressions")
654 (eval '(cond (#t identity =>))
655 (interaction-environment)))
657 (pass-if-syntax-error "extra recipient"
658 '(cond . "wrong number of receiver expressions")
659 (eval '(cond (#t identity => identity identity))
660 (interaction-environment))))
662 (with-test-prefix "bad or missing clauses"
664 (pass-if-syntax-error "(cond)"
665 exception:generic-syncase-error
667 (interaction-environment)))
669 (pass-if-syntax-error "(cond #t)"
670 '(cond . "invalid clause")
672 (interaction-environment)))
674 (pass-if-syntax-error "(cond 1)"
675 '(cond . "invalid clause")
677 (interaction-environment)))
679 (pass-if-syntax-error "(cond 1 2)"
680 '(cond . "invalid clause")
682 (interaction-environment)))
684 (pass-if-syntax-error "(cond 1 2 3)"
685 '(cond . "invalid clause")
687 (interaction-environment)))
689 (pass-if-syntax-error "(cond 1 2 3 4)"
690 '(cond . "invalid clause")
691 (eval '(cond 1 2 3 4)
692 (interaction-environment)))
694 (pass-if-syntax-error "(cond ())"
695 '(cond . "invalid clause")
697 (interaction-environment)))
699 (pass-if-syntax-error "(cond () 1)"
700 '(cond . "invalid clause")
702 (interaction-environment)))
704 (pass-if-syntax-error "(cond (1) 1)"
705 '(cond . "invalid clause")
707 (interaction-environment)))
709 (pass-if-syntax-error "(cond (else #f) (#t #t))"
710 '(cond . "else must be the last clause")
711 (eval '(cond (else #f) (#t #t))
712 (interaction-environment))))
714 (with-test-prefix "wrong number of arguments"
716 (pass-if-exception "=> (lambda (x y) #t)"
717 exception:wrong-num-args
718 (cond (1 => (lambda (x y) #t))))))
720 (with-test-prefix "case"
722 (pass-if "clause with empty labels list"
723 (case 1 (() #f) (else #t)))
725 (with-test-prefix "case handles '=> correctly"
727 (pass-if "(1 2 3) => list"
728 (equal? (case 1 ((1 2 3) => list))
731 (pass-if "else => list"
737 (with-test-prefix "bound '=> is handled correctly"
739 (pass-if "(1) => 'ok"
741 (eq? (case 1 ((1) => 'ok)) 'ok)))
745 (eq? (case 1 (else =>)) 'foo)))
747 (pass-if "else => list"
749 (eq? (case 1 (else => identity)) identity))))
751 (pass-if-syntax-error "missing recipient"
752 '(case . "wrong number of receiver expressions")
753 (eval '(case 1 ((1) =>))
754 (interaction-environment)))
756 (pass-if-syntax-error "extra recipient"
757 '(case . "wrong number of receiver expressions")
758 (eval '(case 1 ((1) => identity identity))
759 (interaction-environment))))
761 (with-test-prefix "case is hygienic"
763 (pass-if-syntax-error "bound 'else is handled correctly"
764 '(case . "invalid clause")
765 (eval '(let ((else #f)) (case 1 (else #f)))
766 (interaction-environment))))
768 (with-test-prefix "bad or missing clauses"
770 (pass-if-syntax-error "(case)"
771 exception:generic-syncase-error
773 (interaction-environment)))
775 (pass-if-syntax-error "(case . \"foo\")"
776 exception:generic-syncase-error
777 (eval '(case . "foo")
778 (interaction-environment)))
780 (pass-if-syntax-error "(case 1)"
781 exception:generic-syncase-error
783 (interaction-environment)))
785 (pass-if-syntax-error "(case 1 . \"foo\")"
786 exception:generic-syncase-error
787 (eval '(case 1 . "foo")
788 (interaction-environment)))
790 (pass-if-syntax-error "(case 1 \"foo\")"
791 '(case . "invalid clause")
792 (eval '(case 1 "foo")
793 (interaction-environment)))
795 (pass-if-syntax-error "(case 1 ())"
796 '(case . "invalid clause")
798 (interaction-environment)))
800 (pass-if-syntax-error "(case 1 (\"foo\"))"
801 '(case . "invalid clause")
802 (eval '(case 1 ("foo"))
803 (interaction-environment)))
805 (pass-if-syntax-error "(case 1 (\"foo\" \"bar\"))"
806 '(case . "invalid clause")
807 (eval '(case 1 ("foo" "bar"))
808 (interaction-environment)))
810 (pass-if-syntax-error "(case 1 ((2) \"bar\") . \"foo\")"
811 exception:generic-syncase-error
812 (eval '(case 1 ((2) "bar") . "foo")
813 (interaction-environment)))
815 (pass-if-syntax-error "(case 1 ((2) \"bar\") (else))"
816 '(case . "invalid clause")
817 (eval '(case 1 ((2) "bar") (else))
818 (interaction-environment)))
820 (pass-if-syntax-error "(case 1 (else #f) . \"foo\")"
821 exception:generic-syncase-error
822 (eval '(case 1 (else #f) . "foo")
823 (interaction-environment)))
825 (pass-if-syntax-error "(case 1 (else #f) ((1) #t))"
826 '(case . "else must be the last clause")
827 (eval '(case 1 (else #f) ((1) #t))
828 (interaction-environment)))))
830 (with-test-prefix "top-level define"
832 (pass-if "redefinition"
833 (let ((m (make-module)))
834 (beautify-user-module! m)
836 ;; The previous value of `round' must still be visible at the time the
837 ;; new `round' is defined. According to R5RS (Section 5.2.1), `define'
838 ;; should behave like `set!' in this case (except that in the case of
839 ;; Guile, we respect module boundaries).
840 (eval '(define round round) m)
841 (eq? (module-ref m 'round) round)))
843 (with-test-prefix "missing or extra expressions"
845 (pass-if-syntax-error "(define)"
846 exception:generic-syncase-error
848 (interaction-environment))))
850 (pass-if "module scoping"
854 (define-module (top-level-define/module-scoping-1)
855 #:export (define-10))
856 (define-syntax-rule (define-10 name)
860 (define-module (top-level-define/module-scoping-2)
861 #:use-module (top-level-define/module-scoping-1))
867 (pass-if "module scoping, same symbolic name"
871 (define-module (top-level-define/module-scoping-3))
873 (define-module (top-level-define/module-scoping-4)
874 #:use-module (top-level-define/module-scoping-3))
875 (define a (@@ (top-level-define/module-scoping-3) a))
880 (pass-if "module scoping, introduced names"
884 (define-module (top-level-define/module-scoping-5)
885 #:export (define-constant))
886 (define-syntax-rule (define-constant name val)
890 (define-module (top-level-define/module-scoping-6)
891 #:use-module (top-level-define/module-scoping-5))
892 (define-constant foo 10)
893 (define-constant bar 20)
898 (pass-if "module scoping, duplicate introduced name"
902 (define-module (top-level-define/module-scoping-7)
903 #:export (define-constant))
904 (define-syntax-rule (define-constant name val)
908 (define-module (top-level-define/module-scoping-8)
909 #:use-module (top-level-define/module-scoping-7))
910 (define-constant foo 10)
911 (define-constant foo 20)
916 (with-test-prefix "internal define"
918 (pass-if "internal defines become letrec"
919 (eval '(let ((a identity) (b identity) (c identity))
920 (define (a x) (if (= x 0) 'a (b (- x 1))))
921 (define (b x) (if (= x 0) 'b (c (- x 1))))
922 (define (c x) (if (= x 0) 'c (a (- x 1))))
923 (and (eq? 'a (a 0) (a 3))
925 (eq? 'c (a 2) (a 5))))
926 (interaction-environment)))
928 (pass-if "binding is created before expression is evaluated"
929 ;; Internal defines are equivalent to `letrec' (R5RS, Section 5.2.2).
936 (interaction-environment))
939 (pass-if "internal defines with begin"
941 (eval '(let ((a identity) (b identity) (c identity))
942 (define (a x) (if (= x 0) 'a (b (- x 1))))
944 (define (b x) (if (= x 0) 'b (c (- x 1)))))
945 (define (c x) (if (= x 0) 'c (a (- x 1))))
946 (and (eq? 'a (a 0) (a 3))
948 (eq? 'c (a 2) (a 5))))
949 (interaction-environment))))
951 (pass-if "internal defines with empty begin"
953 (eval '(let ((a identity) (b identity) (c identity))
954 (define (a x) (if (= x 0) 'a (b (- x 1))))
956 (define (b x) (if (= x 0) 'b (c (- x 1))))
957 (define (c x) (if (= x 0) 'c (a (- x 1))))
958 (and (eq? 'a (a 0) (a 3))
960 (eq? 'c (a 2) (a 5))))
961 (interaction-environment))))
963 (pass-if "internal defines with macro application"
966 (defmacro my-define forms
967 (cons 'define forms))
968 (let ((a identity) (b identity) (c identity))
969 (define (a x) (if (= x 0) 'a (b (- x 1))))
970 (my-define (b x) (if (= x 0) 'b (c (- x 1))))
971 (define (c x) (if (= x 0) 'c (a (- x 1))))
972 (and (eq? 'a (a 0) (a 3))
974 (eq? 'c (a 2) (a 5)))))
975 (interaction-environment))))
977 (pass-if-syntax-error "missing body expression"
978 exception:missing-body-expr
979 (eval '(let () (define x #t))
980 (interaction-environment))))
982 (with-test-prefix "top-level define-values"
984 (pass-if "zero values"
985 (eval '(begin (define-values () (values))
987 (interaction-environment)))
989 (pass-if-equal "one value"
991 (eval '(begin (define-values (x) 1)
993 (interaction-environment)))
995 (pass-if-equal "two values"
997 (eval '(begin (define-values (x y) (values 2 3))
999 (interaction-environment)))
1001 (pass-if-equal "three values"
1003 (eval '(begin (define-values (x y z) (values 4 5 6))
1005 (interaction-environment)))
1007 (pass-if-equal "one value with tail"
1009 (eval '(begin (define-values (x . y) (values 'a 'b 'c 'd))
1011 (interaction-environment)))
1013 (pass-if-equal "two values with tail"
1015 (eval '(begin (define-values (x y . z) (values 'x 'y 'z 'w))
1017 (interaction-environment)))
1019 (pass-if-equal "just tail"
1021 (eval '(begin (define-values x (values 1 2 3))
1023 (interaction-environment)))
1025 (pass-if-exception "expected 0 values, got 1"
1026 exception:wrong-number-of-values
1027 (eval '(define-values () 1)
1028 (interaction-environment)))
1030 (pass-if-exception "expected 1 value, got 0"
1031 exception:wrong-number-of-values
1032 (eval '(define-values (x) (values))
1033 (interaction-environment)))
1035 (pass-if-exception "expected 1 value, got 2"
1036 exception:wrong-number-of-values
1037 (eval '(define-values (x) (values 1 2))
1038 (interaction-environment)))
1040 (pass-if-exception "expected 1 value with tail, got 0"
1041 exception:wrong-number-of-values
1042 (eval '(define-values (x . y) (values))
1043 (interaction-environment)))
1045 (pass-if-exception "expected 2 value with tail, got 1"
1046 exception:wrong-number-of-values
1047 (eval '(define-values (x y . z) 1)
1048 (interaction-environment)))
1050 (pass-if "redefinition"
1051 (let ((m (make-module)))
1052 (beautify-user-module! m)
1054 ;; The previous values of `floor' and `round' must still be
1055 ;; visible at the time the new `floor' and `round' are defined.
1056 (eval '(define-values (floor round) (values floor round)) m)
1057 (and (eq? (module-ref m 'floor) floor)
1058 (eq? (module-ref m 'round) round))))
1060 (with-test-prefix "missing expression"
1062 (pass-if-syntax-error "(define-values)"
1063 exception:generic-syncase-error
1064 (eval '(define-values)
1065 (interaction-environment)))))
1067 (with-test-prefix "internal define-values"
1069 (pass-if "zero values"
1071 (define-values () (values))
1074 (pass-if-equal "one value"
1077 (define-values (x) 1)
1080 (pass-if-equal "two values"
1083 (define-values (x y) (values 2 3))
1086 (pass-if-equal "three values"
1089 (define-values (x y z) (values 4 5 6))
1092 (pass-if-equal "one value with tail"
1095 (define-values (x . y) (values 'a 'b 'c 'd))
1098 (pass-if-equal "two values with tail"
1101 (define-values (x y . z) (values 'x 'y 'z 'w))
1104 (pass-if-equal "just tail"
1107 (define-values x (values 1 2 3))
1110 (pass-if-exception "expected 0 values, got 1"
1111 exception:wrong-number-of-values
1113 (define-values () 1)
1115 (interaction-environment)))
1117 (pass-if-exception "expected 1 value, got 0"
1118 exception:wrong-number-of-values
1120 (define-values (x) (values))
1122 (interaction-environment)))
1124 (pass-if-exception "expected 1 value, got 2"
1125 exception:wrong-number-of-values
1127 (define-values (x) (values 1 2))
1129 (interaction-environment)))
1131 (pass-if-exception "expected 1 value with tail, got 0"
1132 exception:wrong-number-of-values
1134 (define-values (x . y) (values))
1136 (interaction-environment)))
1138 (pass-if-exception "expected 2 value with tail, got 1"
1139 exception:wrong-number-of-values
1141 (define-values (x y . z) 1)
1143 (interaction-environment)))
1145 (with-test-prefix "missing expression"
1147 (pass-if-syntax-error "(define-values)"
1148 exception:generic-syncase-error
1152 (interaction-environment)))))
1154 (with-test-prefix "set!"
1156 (with-test-prefix "missing or extra expressions"
1158 (pass-if-syntax-error "(set!)"
1161 (interaction-environment)))
1163 (pass-if-syntax-error "(set! 1)"
1166 (interaction-environment)))
1168 (pass-if-syntax-error "(set! 1 2 3)"
1171 (interaction-environment))))
1173 (with-test-prefix "bad variable"
1175 (pass-if-syntax-error "(set! \"\" #t)"
1178 (interaction-environment)))
1180 (pass-if-syntax-error "(set! 1 #t)"
1183 (interaction-environment)))
1185 (pass-if-syntax-error "(set! #t #f)"
1188 (interaction-environment)))
1190 (pass-if-syntax-error "(set! #f #t)"
1193 (interaction-environment)))
1195 (pass-if-syntax-error "(set! #\\space #f)"
1197 (eval '(set! #\space #f)
1198 (interaction-environment)))))
1200 (with-test-prefix "quote"
1202 (with-test-prefix "missing or extra expression"
1204 (pass-if-syntax-error "(quote)"
1207 (interaction-environment)))
1209 (pass-if-syntax-error "(quote a b)"
1212 (interaction-environment)))))
1214 (with-test-prefix "while"
1216 (define (unreachable)
1217 (error "unreachable code has been reached!"))
1219 ;; Return a new procedure COND which when called (COND) will return #t the
1220 ;; first N times, then #f, then any further call is an error. N=0 is
1221 ;; allowed, in which case #f is returned by the first call.
1222 (define (make-iterations-cond n)
1225 (error "oops, condition re-tested after giving false"))
1234 (pass-if-syntax-error "too few args" exception:generic-syncase-error
1235 (eval '(while) (interaction-environment)))
1237 (with-test-prefix "empty body"
1241 (eval `(letrec ((make-iterations-cond
1245 (error "oops, condition re-tested after giving false"))
1252 (let ((cond (make-iterations-cond ,n)))
1255 (interaction-environment)))))
1257 (pass-if "initially false"
1262 (with-test-prefix "iterations"
1266 (let ((cond (make-iterations-cond n))
1272 (with-test-prefix "break"
1274 (pass-if "normal return"
1275 (not (while #f (error "not reached"))))
1280 (pass-if "multiple values"
1283 (lambda () (while #t (break 1 2 3)))
1286 (with-test-prefix "from cond"
1297 (let ((cond (make-iterations-cond n))
1307 (with-test-prefix "from body"
1317 (let ((cond (make-iterations-cond n))
1327 (pass-if "from nested"
1329 (let ((outer-break break))
1336 (pass-if "from recursive"
1337 (let ((outer-break #f))
1342 (set! outer-break break)
1348 (error "broke only from inner loop")))
1352 (with-test-prefix "continue"
1354 (pass-if-syntax-error "too many args" exception:too-many-args
1357 (interaction-environment)))
1359 (with-test-prefix "from cond"
1363 (let ((cond (make-iterations-cond n))
1374 (with-test-prefix "from body"
1378 (let ((cond (make-iterations-cond n))
1386 (pass-if "from nested"
1387 (let ((cond (make-iterations-cond 3)))
1389 (let ((outer-continue continue))
1395 (pass-if "from recursive"
1396 (let ((outer-continue #f))
1398 (let ((cond (make-iterations-cond 3))
1401 (if (and (not first)
1403 (error "continued only to inner loop"))
1408 (set! outer-continue continue)
1416 (with-test-prefix "syntax-rules"
1418 (pass-if-equal "custom ellipsis within normal ellipsis"
1419 '((((a x) (a y) (a …))
1421 ((c x) (c y) (c …)))
1422 (((a x) (b x) (c x))
1424 ((a …) (b …) (c …))))
1432 (((x y) …) ...)))))))
1433 (define-syntax bar (foo x y …))
1436 (pass-if-equal "normal ellipsis within custom ellipsis"
1437 '((((a x) (a y) (a z))
1439 ((c x) (c y) (c z)))
1440 (((a x) (b x) (c x))
1442 ((a z) (b z) (c z))))
1450 (((x y) ...) …)))))))
1451 (define-syntax bar (foo x y z))
1454 ;; This test is given in SRFI-46.
1455 (pass-if-equal "custom ellipsis is handled hygienically"
1458 ((f (syntax-rules ()
1461 ((g (syntax-rules --- ()
1462 ((g (??x ?e) (??y ---))
1463 '((??x) ?e (??y) ---)))))
1464 (g (1 2) (3 4)))))))
1467 (with-test-prefix "syntax-error"
1469 (pass-if-syntax-error "outside of macro without args"
1471 (eval '(syntax-error "test error")
1472 (interaction-environment)))
1474 (pass-if-syntax-error "outside of macro with args"
1475 "test error x \\(y z\\)"
1476 (eval '(syntax-error "test error" x (y z))
1477 (interaction-environment)))
1479 (pass-if-equal "within macro"
1481 "expected an identifier but got (z1 z2)"
1482 (simple-let ((y (* x x))
1483 ((z1 z2) (values x x)))
1485 (catch 'syntax-error
1488 (define-syntax simple-let
1490 ((_ (head ... ((x . y) val) . tail)
1493 "expected an identifier but got"
1495 ((_ ((name val) ...) body1 body2 ...)
1496 ((lambda (name ...) body1 body2 ...)
1499 (simple-let ((y (* x x))
1500 ((z1 z2) (values x x)))
1503 (interaction-environment))
1504 (error "expected syntax-error exception"))
1505 (lambda (k who what where form . maybe-subform)
1506 (list who what form)))))
1508 (with-test-prefix "syntax-case"
1510 (pass-if-syntax-error "duplicate pattern variable"
1511 '(syntax-case . "duplicate pattern variable")
1514 ((a b c d e d f) #f)))
1515 (interaction-environment)))
1517 (with-test-prefix "misplaced ellipses"
1519 (pass-if-syntax-error "bare ellipsis"
1520 '(syntax-case . "misplaced ellipsis")
1524 (interaction-environment)))
1526 (pass-if-syntax-error "ellipsis singleton"
1527 '(syntax-case . "misplaced ellipsis")
1531 (interaction-environment)))
1533 (pass-if-syntax-error "ellipsis in car"
1534 '(syntax-case . "misplaced ellipsis")
1538 (interaction-environment)))
1540 (pass-if-syntax-error "ellipsis in cdr"
1541 '(syntax-case . "misplaced ellipsis")
1545 (interaction-environment)))
1547 (pass-if-syntax-error "two ellipses in the same list"
1548 '(syntax-case . "misplaced ellipsis")
1551 ((x ... y ...) #f)))
1552 (interaction-environment)))
1554 (pass-if-syntax-error "three ellipses in the same list"
1555 '(syntax-case . "misplaced ellipsis")
1558 ((x ... y ... z ...) #f)))
1559 (interaction-environment)))))
1561 (with-test-prefix "with-ellipsis"
1563 (pass-if-equal "simple"
1566 (define-syntax define-quotation-macros
1569 ((_ (macro-name head-symbol) ...)
1570 #'(begin (define-syntax macro-name
1575 #'(quote (head-symbol x …)))))))
1577 (define-quotation-macros (quote-a a) (quote-b b))
1580 (pass-if-equal "disables normal ellipsis"
1588 #'(quote (a ...)))))))
1591 (pass-if-equal "doesn't affect ellipsis for generated code"
1594 (define-syntax quotation-macro
1602 #'(quote (x ...))))))))))
1603 (define-syntax kwote (quotation-macro))
1606 (pass-if-equal "propagates into syntax binders"
1610 (define-syntax kwote
1617 (pass-if-equal "works with local-eval"
1619 (let ((env (with-ellipsis … (the-environment))))
1620 (local-eval '(syntax-case #'(a b c d e) ()
1625 ;;; Local Variables:
1626 ;;; eval: (put 'pass-if-syntax-error 'scheme-indent-function 1)
1627 ;;; eval: (put 'with-ellipsis 'scheme-indent-function 1)