1 ;;;; syntax.test --- test suite for Guile's syntactic forms -*- scheme -*-
3 ;;;; Copyright (C) 2001, 2003, 2004, 2005, 2006, 2009, 2010,
4 ;;;; 2011, 2012 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 (test-suite lib))
25 (define exception:generic-syncase-error
26 "source expression failed to match")
27 (define exception:unexpected-syntax
30 (define exception:bad-expression
33 (define exception:missing/extra-expr
34 "Missing or extra expression")
35 (define exception:missing-expr
37 (define exception:missing-body-expr
38 "no expressions in body")
39 (define exception:extra-expr
41 (define exception:illegal-empty-combination
42 "Illegal empty combination")
44 (define exception:bad-lambda
46 (define exception:bad-let
48 (define exception:bad-letrec
50 (define exception:bad-letrec*
52 (define exception:bad-set!
54 (define exception:bad-quote
55 '(quote . "bad syntax"))
56 (define exception:bad-bindings
58 (define exception:bad-binding
60 (define exception:duplicate-binding
61 "duplicate bound variable")
62 (define exception:bad-body
64 (define exception:bad-formals
65 "invalid argument list")
66 (define exception:bad-formal
68 (define exception:duplicate-formals
69 "duplicate identifier in argument list")
71 (define exception:missing-clauses
73 (define exception:misplaced-else-clause
74 "Misplaced else clause")
75 (define exception:bad-case-clause
77 (define exception:bad-case-labels
79 (define exception:bad-cond-clause
82 (define exception:too-many-args
84 (define exception:zero-expression-sequence
85 "sequence of zero expressions")
88 ;; (put 'pass-if-syntax-error 'scheme-indent-function 1)
89 (define-syntax pass-if-syntax-error
94 (lambda () exp (error "expected syntax-error exception"))
95 (lambda (k who what where form . maybe-subform)
97 (and (eq? who (car pat))
98 (string-match (cdr pat) what))
99 (string-match pat what))
101 (error "unexpected syntax-error exception" what pat))))))))
103 (with-test-prefix "expressions"
105 (with-test-prefix "Bad argument list"
107 (pass-if-syntax-error "improper argument list of length 1"
108 exception:generic-syncase-error
109 (eval '(let ((foo (lambda (x y) #t)))
111 (interaction-environment)))
113 (pass-if-syntax-error "improper argument list of length 2"
114 exception:generic-syncase-error
115 (eval '(let ((foo (lambda (x y) #t)))
117 (interaction-environment))))
119 (with-test-prefix "missing or extra expression"
122 ;; *Note:* In many dialects of Lisp, the empty combination, (),
123 ;; is a legitimate expression. In Scheme, combinations must
124 ;; have at least one subexpression, so () is not a syntactically
128 (pass-if-syntax-error "empty parentheses \"()\""
129 exception:unexpected-syntax
131 (interaction-environment)))))
133 (with-test-prefix "quote"
136 (with-test-prefix "quasiquote"
138 (with-test-prefix "unquote"
140 (pass-if "repeated execution"
141 (let ((foo (let ((i 0)) (lambda () (set! i (+ i 1)) `(,i)))))
142 (and (equal? (foo) '(1)) (equal? (foo) '(2))))))
144 (with-test-prefix "unquote-splicing"
146 (pass-if "extra arguments"
147 (equal? (eval '(quasiquote ((unquote-splicing (list 1 2) (list 3 4))))
148 (interaction-environment))
151 (with-test-prefix "begin"
153 (pass-if "valid (begin)"
154 (eval '(begin (begin) #t) (interaction-environment)))
156 (if (not (include-deprecated-features))
157 (pass-if-syntax-error "invalid (begin)"
158 exception:zero-expression-sequence
159 (eval '(begin (if #t (begin)) #t) (interaction-environment)))))
161 (define-syntax matches?
163 ((_ (op arg ...) pat) (let ((x (op arg ...)))
166 ((_ x (a . b)) (and (pair? x)
168 (matches? (cdr x) b)))
170 ((_ x pat) (equal? x 'pat))))
172 (with-test-prefix "lambda"
174 (with-test-prefix "bad formals"
176 (pass-if-syntax-error "(lambda)"
179 (interaction-environment)))
181 (pass-if-syntax-error "(lambda . \"foo\")"
183 (eval '(lambda . "foo")
184 (interaction-environment)))
186 (pass-if-syntax-error "(lambda \"foo\")"
188 (eval '(lambda "foo")
189 (interaction-environment)))
191 (pass-if-syntax-error "(lambda \"foo\" #f)"
192 exception:bad-formals
193 (eval '(lambda "foo" #f)
194 (interaction-environment)))
196 (pass-if-syntax-error "(lambda (x 1) 2)"
197 exception:bad-formals
198 (eval '(lambda (x 1) 2)
199 (interaction-environment)))
201 (pass-if-syntax-error "(lambda (1 x) 2)"
202 exception:bad-formals
203 (eval '(lambda (1 x) 2)
204 (interaction-environment)))
206 (pass-if-syntax-error "(lambda (x \"a\") 2)"
207 exception:bad-formals
208 (eval '(lambda (x "a") 2)
209 (interaction-environment)))
211 (pass-if-syntax-error "(lambda (\"a\" x) 2)"
212 exception:bad-formals
213 (eval '(lambda ("a" x) 2)
214 (interaction-environment))))
216 (with-test-prefix "duplicate formals"
219 (pass-if-syntax-error "(lambda (x x) 1)"
220 exception:duplicate-formals
221 (eval '(lambda (x x) 1)
222 (interaction-environment)))
225 (pass-if-syntax-error "(lambda (x x x) 1)"
226 exception:duplicate-formals
227 (eval '(lambda (x x x) 1)
228 (interaction-environment))))
230 (with-test-prefix "bad body"
232 (pass-if-syntax-error "(lambda ())"
235 (interaction-environment)))))
237 (with-test-prefix "let"
239 (with-test-prefix "bindings"
241 (pass-if-exception "late binding"
242 exception:unbound-var
243 (let ((x 1) (y x)) y)))
245 (with-test-prefix "bad bindings"
247 (pass-if-syntax-error "(let)"
250 (interaction-environment)))
252 (pass-if-syntax-error "(let 1)"
255 (interaction-environment)))
257 (pass-if-syntax-error "(let (x))"
260 (interaction-environment)))
262 (pass-if-syntax-error "(let ((x)))"
265 (interaction-environment)))
267 (pass-if-syntax-error "(let (x) 1)"
270 (interaction-environment)))
272 (pass-if-syntax-error "(let ((x)) 3)"
275 (interaction-environment)))
277 (pass-if-syntax-error "(let ((x 1) y) x)"
279 (eval '(let ((x 1) y) x)
280 (interaction-environment)))
282 (pass-if-syntax-error "(let ((1 2)) 3)"
284 (eval '(let ((1 2)) 3)
285 (interaction-environment))))
287 (with-test-prefix "duplicate bindings"
289 (pass-if-syntax-error "(let ((x 1) (x 2)) x)"
290 exception:duplicate-binding
291 (eval '(let ((x 1) (x 2)) x)
292 (interaction-environment))))
294 (with-test-prefix "bad body"
296 (pass-if-syntax-error "(let ())"
299 (interaction-environment)))
301 (pass-if-syntax-error "(let ((x 1)))"
304 (interaction-environment)))))
306 (with-test-prefix "named let"
308 (with-test-prefix "initializers"
310 (pass-if "evaluated in outer environment"
312 (eqv? (let f ((n (f 1))) n) -1))))
314 (with-test-prefix "bad bindings"
316 (pass-if-syntax-error "(let x (y))"
319 (interaction-environment))))
321 (with-test-prefix "bad body"
323 (pass-if-syntax-error "(let x ())"
326 (interaction-environment)))
328 (pass-if-syntax-error "(let x ((y 1)))"
330 (eval '(let x ((y 1)))
331 (interaction-environment)))))
333 (with-test-prefix "let*"
335 (with-test-prefix "bindings"
337 (pass-if "(let* ((x 1) (x 2)) ...)"
341 (pass-if "(let* ((x 1) (x x)) ...)"
345 (pass-if "(let ((x 1) (y 2)) (let* () ...))"
348 (and (= x 1) (= y 2))))))
350 (with-test-prefix "bad bindings"
352 (pass-if-syntax-error "(let*)"
353 exception:generic-syncase-error
355 (interaction-environment)))
357 (pass-if-syntax-error "(let* 1)"
358 exception:generic-syncase-error
360 (interaction-environment)))
362 (pass-if-syntax-error "(let* (x))"
363 exception:generic-syncase-error
365 (interaction-environment)))
367 (pass-if-syntax-error "(let* (x) 1)"
368 exception:generic-syncase-error
370 (interaction-environment)))
372 (pass-if-syntax-error "(let* ((x)) 3)"
373 exception:generic-syncase-error
374 (eval '(let* ((x)) 3)
375 (interaction-environment)))
377 (pass-if-syntax-error "(let* ((x 1) y) x)"
378 exception:generic-syncase-error
379 (eval '(let* ((x 1) y) x)
380 (interaction-environment)))
382 (pass-if-syntax-error "(let* x ())"
383 exception:generic-syncase-error
385 (interaction-environment)))
387 (pass-if-syntax-error "(let* x (y))"
388 exception:generic-syncase-error
390 (interaction-environment)))
392 (pass-if-syntax-error "(let* ((1 2)) 3)"
393 exception:generic-syncase-error
394 (eval '(let* ((1 2)) 3)
395 (interaction-environment))))
397 (with-test-prefix "bad body"
399 (pass-if-syntax-error "(let* ())"
400 exception:generic-syncase-error
402 (interaction-environment)))
404 (pass-if-syntax-error "(let* ((x 1)))"
405 exception:generic-syncase-error
406 (eval '(let* ((x 1)))
407 (interaction-environment)))))
409 (with-test-prefix "letrec"
411 (with-test-prefix "bindings"
413 (pass-if-syntax-error "initial bindings are undefined"
414 exception:used-before-defined
416 ;; FIXME: the memoizer does initialize the var to undefined, but
417 ;; the Scheme evaluator has no way of checking what's an
418 ;; undefined value. Not sure how to do this.
420 (letrec ((x 1) (y x)) y))))
422 (with-test-prefix "bad bindings"
424 (pass-if-syntax-error "(letrec)"
427 (interaction-environment)))
429 (pass-if-syntax-error "(letrec 1)"
432 (interaction-environment)))
434 (pass-if-syntax-error "(letrec (x))"
437 (interaction-environment)))
439 (pass-if-syntax-error "(letrec (x) 1)"
441 (eval '(letrec (x) 1)
442 (interaction-environment)))
444 (pass-if-syntax-error "(letrec ((x)) 3)"
446 (eval '(letrec ((x)) 3)
447 (interaction-environment)))
449 (pass-if-syntax-error "(letrec ((x 1) y) x)"
451 (eval '(letrec ((x 1) y) x)
452 (interaction-environment)))
454 (pass-if-syntax-error "(letrec x ())"
457 (interaction-environment)))
459 (pass-if-syntax-error "(letrec x (y))"
461 (eval '(letrec x (y))
462 (interaction-environment)))
464 (pass-if-syntax-error "(letrec ((1 2)) 3)"
466 (eval '(letrec ((1 2)) 3)
467 (interaction-environment))))
469 (with-test-prefix "duplicate bindings"
471 (pass-if-syntax-error "(letrec ((x 1) (x 2)) x)"
472 exception:duplicate-binding
473 (eval '(letrec ((x 1) (x 2)) x)
474 (interaction-environment))))
476 (with-test-prefix "bad body"
478 (pass-if-syntax-error "(letrec ())"
481 (interaction-environment)))
483 (pass-if-syntax-error "(letrec ((x 1)))"
485 (eval '(letrec ((x 1)))
486 (interaction-environment)))))
488 (with-test-prefix "letrec*"
490 (with-test-prefix "bindings"
492 (pass-if-syntax-error "initial bindings are undefined"
493 exception:used-before-defined
495 ;; FIXME: the memoizer does initialize the var to undefined, but
496 ;; the Scheme evaluator has no way of checking what's an
497 ;; undefined value. Not sure how to do this.
499 (letrec* ((x y) (y 1)) y))))
501 (with-test-prefix "bad bindings"
503 (pass-if-syntax-error "(letrec*)"
504 exception:bad-letrec*
506 (interaction-environment)))
508 (pass-if-syntax-error "(letrec* 1)"
509 exception:bad-letrec*
511 (interaction-environment)))
513 (pass-if-syntax-error "(letrec* (x))"
514 exception:bad-letrec*
516 (interaction-environment)))
518 (pass-if-syntax-error "(letrec* (x) 1)"
519 exception:bad-letrec*
520 (eval '(letrec* (x) 1)
521 (interaction-environment)))
523 (pass-if-syntax-error "(letrec* ((x)) 3)"
524 exception:bad-letrec*
525 (eval '(letrec* ((x)) 3)
526 (interaction-environment)))
528 (pass-if-syntax-error "(letrec* ((x 1) y) x)"
529 exception:bad-letrec*
530 (eval '(letrec* ((x 1) y) x)
531 (interaction-environment)))
533 (pass-if-syntax-error "(letrec* x ())"
534 exception:bad-letrec*
535 (eval '(letrec* x ())
536 (interaction-environment)))
538 (pass-if-syntax-error "(letrec* x (y))"
539 exception:bad-letrec*
540 (eval '(letrec* x (y))
541 (interaction-environment)))
543 (pass-if-syntax-error "(letrec* ((1 2)) 3)"
544 exception:bad-letrec*
545 (eval '(letrec* ((1 2)) 3)
546 (interaction-environment))))
548 (with-test-prefix "duplicate bindings"
550 (pass-if-syntax-error "(letrec* ((x 1) (x 2)) x)"
551 exception:duplicate-binding
552 (eval '(letrec* ((x 1) (x 2)) x)
553 (interaction-environment))))
555 (with-test-prefix "bad body"
557 (pass-if-syntax-error "(letrec* ())"
558 exception:bad-letrec*
560 (interaction-environment)))
562 (pass-if-syntax-error "(letrec* ((x 1)))"
563 exception:bad-letrec*
564 (eval '(letrec* ((x 1)))
565 (interaction-environment))))
567 (with-test-prefix "referencing previous values"
568 (pass-if (equal? (letrec ((a (cons 'foo 'bar))
572 (pass-if (equal? (let ()
573 (define a (cons 'foo 'bar))
578 (with-test-prefix "if"
580 (with-test-prefix "missing or extra expressions"
582 (pass-if-syntax-error "(if)"
583 exception:generic-syncase-error
585 (interaction-environment)))
587 (pass-if-syntax-error "(if 1 2 3 4)"
588 exception:generic-syncase-error
590 (interaction-environment)))))
592 (with-test-prefix "cond"
594 (with-test-prefix "cond is hygienic"
596 (pass-if "bound 'else is handled correctly"
597 (eq? (let ((else 'ok)) (cond (else))) 'ok))
599 (with-test-prefix "bound '=> is handled correctly"
603 (eq? (cond (#t => 'ok)) 'ok)))
607 (eq? (cond (else =>)) 'foo)))
609 (pass-if "else => identity"
611 (eq? (cond (else => identity)) identity)))))
613 (with-test-prefix "SRFI-61"
615 (pass-if "always available"
616 (cond-expand (srfi-61 #t) (else #f)))
618 (pass-if "single value consequent"
619 (eq? 'ok (cond (#t identity => (lambda (x) 'ok)) (else #f))))
621 (pass-if "single value alternate"
622 (eq? 'ok (cond (#t not => (lambda (x) #f)) (else 'ok))))
624 (pass-if-exception "doesn't affect standard =>"
625 exception:wrong-num-args
626 (cond ((values 1 2) => (lambda (x y) #t))))
628 (pass-if "multiple values consequent"
629 (equal? '(2 1) (cond ((values 1 2)
631 (and (= 1 one) (= 2 two))) =>
632 (lambda (one two) (list two one)))
635 (pass-if "multiple values alternate"
636 (eq? 'ok (cond ((values 2 3 4)
637 (lambda args (equal? '(1 2 3) args)) =>
641 (pass-if "zero values"
642 (eq? 'ok (cond ((values) (lambda () #t) => (lambda () 'ok))
645 (pass-if "bound => is handled correctly"
647 (eq? 'ok (cond (#t identity =>) (else #f)))))
649 (pass-if-syntax-error "missing recipient"
650 '(cond . "wrong number of receiver expressions")
651 (eval '(cond (#t identity =>))
652 (interaction-environment)))
654 (pass-if-syntax-error "extra recipient"
655 '(cond . "wrong number of receiver expressions")
656 (eval '(cond (#t identity => identity identity))
657 (interaction-environment))))
659 (with-test-prefix "bad or missing clauses"
661 (pass-if-syntax-error "(cond)"
662 exception:generic-syncase-error
664 (interaction-environment)))
666 (pass-if-syntax-error "(cond #t)"
667 '(cond . "invalid clause")
669 (interaction-environment)))
671 (pass-if-syntax-error "(cond 1)"
672 '(cond . "invalid clause")
674 (interaction-environment)))
676 (pass-if-syntax-error "(cond 1 2)"
677 '(cond . "invalid clause")
679 (interaction-environment)))
681 (pass-if-syntax-error "(cond 1 2 3)"
682 '(cond . "invalid clause")
684 (interaction-environment)))
686 (pass-if-syntax-error "(cond 1 2 3 4)"
687 '(cond . "invalid clause")
688 (eval '(cond 1 2 3 4)
689 (interaction-environment)))
691 (pass-if-syntax-error "(cond ())"
692 '(cond . "invalid clause")
694 (interaction-environment)))
696 (pass-if-syntax-error "(cond () 1)"
697 '(cond . "invalid clause")
699 (interaction-environment)))
701 (pass-if-syntax-error "(cond (1) 1)"
702 '(cond . "invalid clause")
704 (interaction-environment)))
706 (pass-if-syntax-error "(cond (else #f) (#t #t))"
707 '(cond . "else must be the last clause")
708 (eval '(cond (else #f) (#t #t))
709 (interaction-environment))))
711 (with-test-prefix "wrong number of arguments"
713 (pass-if-exception "=> (lambda (x y) #t)"
714 exception:wrong-num-args
715 (cond (1 => (lambda (x y) #t))))))
717 (with-test-prefix "case"
719 (pass-if "clause with empty labels list"
720 (case 1 (() #f) (else #t)))
722 (with-test-prefix "case handles '=> correctly"
724 (pass-if "(1 2 3) => list"
725 (equal? (case 1 ((1 2 3) => list))
728 (pass-if "else => list"
734 (with-test-prefix "bound '=> is handled correctly"
736 (pass-if "(1) => 'ok"
738 (eq? (case 1 ((1) => 'ok)) 'ok)))
742 (eq? (case 1 (else =>)) 'foo)))
744 (pass-if "else => list"
746 (eq? (case 1 (else => identity)) identity))))
748 (pass-if-syntax-error "missing recipient"
749 '(case . "wrong number of receiver expressions")
750 (eval '(case 1 ((1) =>))
751 (interaction-environment)))
753 (pass-if-syntax-error "extra recipient"
754 '(case . "wrong number of receiver expressions")
755 (eval '(case 1 ((1) => identity identity))
756 (interaction-environment))))
758 (with-test-prefix "case is hygienic"
760 (pass-if-syntax-error "bound 'else is handled correctly"
761 '(case . "invalid clause")
762 (eval '(let ((else #f)) (case 1 (else #f)))
763 (interaction-environment))))
765 (with-test-prefix "bad or missing clauses"
767 (pass-if-syntax-error "(case)"
768 exception:generic-syncase-error
770 (interaction-environment)))
772 (pass-if-syntax-error "(case . \"foo\")"
773 exception:generic-syncase-error
774 (eval '(case . "foo")
775 (interaction-environment)))
777 (pass-if-syntax-error "(case 1)"
778 exception:generic-syncase-error
780 (interaction-environment)))
782 (pass-if-syntax-error "(case 1 . \"foo\")"
783 exception:generic-syncase-error
784 (eval '(case 1 . "foo")
785 (interaction-environment)))
787 (pass-if-syntax-error "(case 1 \"foo\")"
788 '(case . "invalid clause")
789 (eval '(case 1 "foo")
790 (interaction-environment)))
792 (pass-if-syntax-error "(case 1 ())"
793 '(case . "invalid clause")
795 (interaction-environment)))
797 (pass-if-syntax-error "(case 1 (\"foo\"))"
798 '(case . "invalid clause")
799 (eval '(case 1 ("foo"))
800 (interaction-environment)))
802 (pass-if-syntax-error "(case 1 (\"foo\" \"bar\"))"
803 '(case . "invalid clause")
804 (eval '(case 1 ("foo" "bar"))
805 (interaction-environment)))
807 (pass-if-syntax-error "(case 1 ((2) \"bar\") . \"foo\")"
808 exception:generic-syncase-error
809 (eval '(case 1 ((2) "bar") . "foo")
810 (interaction-environment)))
812 (pass-if-syntax-error "(case 1 ((2) \"bar\") (else))"
813 '(case . "invalid clause")
814 (eval '(case 1 ((2) "bar") (else))
815 (interaction-environment)))
817 (pass-if-syntax-error "(case 1 (else #f) . \"foo\")"
818 exception:generic-syncase-error
819 (eval '(case 1 (else #f) . "foo")
820 (interaction-environment)))
822 (pass-if-syntax-error "(case 1 (else #f) ((1) #t))"
823 '(case . "else must be the last clause")
824 (eval '(case 1 (else #f) ((1) #t))
825 (interaction-environment)))))
827 (with-test-prefix "top-level define"
829 (pass-if "redefinition"
830 (let ((m (make-module)))
831 (beautify-user-module! m)
833 ;; The previous value of `round' must still be visible at the time the
834 ;; new `round' is defined. According to R5RS (Section 5.2.1), `define'
835 ;; should behave like `set!' in this case (except that in the case of
836 ;; Guile, we respect module boundaries).
837 (eval '(define round round) m)
838 (eq? (module-ref m 'round) round)))
840 (with-test-prefix "missing or extra expressions"
842 (pass-if-syntax-error "(define)"
843 exception:generic-syncase-error
845 (interaction-environment))))
847 (pass-if "module scoping"
851 (define-module (top-level-define/module-scoping-1)
852 #:export (define-10))
853 (define-syntax-rule (define-10 name)
857 (define-module (top-level-define/module-scoping-2)
858 #:use-module (top-level-define/module-scoping-1))
864 (pass-if "module scoping, same symbolic name"
868 (define-module (top-level-define/module-scoping-3))
870 (define-module (top-level-define/module-scoping-4)
871 #:use-module (top-level-define/module-scoping-3))
872 (define a (@@ (top-level-define/module-scoping-3) a))
877 (pass-if "module scoping, introduced names"
881 (define-module (top-level-define/module-scoping-5)
882 #:export (define-constant))
883 (define-syntax-rule (define-constant name val)
887 (define-module (top-level-define/module-scoping-6)
888 #:use-module (top-level-define/module-scoping-5))
889 (define-constant foo 10)
890 (define-constant bar 20)
895 (pass-if "module scoping, duplicate introduced name"
899 (define-module (top-level-define/module-scoping-7)
900 #:export (define-constant))
901 (define-syntax-rule (define-constant name val)
905 (define-module (top-level-define/module-scoping-8)
906 #:use-module (top-level-define/module-scoping-7))
907 (define-constant foo 10)
908 (define-constant foo 20)
913 (with-test-prefix "internal define"
915 (pass-if "internal defines become letrec"
916 (eval '(let ((a identity) (b identity) (c identity))
917 (define (a x) (if (= x 0) 'a (b (- x 1))))
918 (define (b x) (if (= x 0) 'b (c (- x 1))))
919 (define (c x) (if (= x 0) 'c (a (- x 1))))
920 (and (eq? 'a (a 0) (a 3))
922 (eq? 'c (a 2) (a 5))))
923 (interaction-environment)))
925 (pass-if "binding is created before expression is evaluated"
926 ;; Internal defines are equivalent to `letrec' (R5RS, Section 5.2.2).
933 (interaction-environment))
936 (pass-if "internal defines with begin"
938 (eval '(let ((a identity) (b identity) (c identity))
939 (define (a x) (if (= x 0) 'a (b (- x 1))))
941 (define (b x) (if (= x 0) 'b (c (- x 1)))))
942 (define (c x) (if (= x 0) 'c (a (- x 1))))
943 (and (eq? 'a (a 0) (a 3))
945 (eq? 'c (a 2) (a 5))))
946 (interaction-environment))))
948 (pass-if "internal defines with empty begin"
950 (eval '(let ((a identity) (b identity) (c identity))
951 (define (a x) (if (= x 0) 'a (b (- x 1))))
953 (define (b x) (if (= x 0) 'b (c (- x 1))))
954 (define (c x) (if (= x 0) 'c (a (- x 1))))
955 (and (eq? 'a (a 0) (a 3))
957 (eq? 'c (a 2) (a 5))))
958 (interaction-environment))))
960 (pass-if "internal defines with macro application"
963 (defmacro my-define forms
964 (cons 'define forms))
965 (let ((a identity) (b identity) (c identity))
966 (define (a x) (if (= x 0) 'a (b (- x 1))))
967 (my-define (b x) (if (= x 0) 'b (c (- x 1))))
968 (define (c x) (if (= x 0) 'c (a (- x 1))))
969 (and (eq? 'a (a 0) (a 3))
971 (eq? 'c (a 2) (a 5)))))
972 (interaction-environment))))
974 (pass-if-syntax-error "missing body expression"
975 exception:missing-body-expr
976 (eval '(let () (define x #t))
977 (interaction-environment))))
979 (with-test-prefix "set!"
981 (with-test-prefix "missing or extra expressions"
983 (pass-if-syntax-error "(set!)"
986 (interaction-environment)))
988 (pass-if-syntax-error "(set! 1)"
991 (interaction-environment)))
993 (pass-if-syntax-error "(set! 1 2 3)"
996 (interaction-environment))))
998 (with-test-prefix "bad variable"
1000 (pass-if-syntax-error "(set! \"\" #t)"
1003 (interaction-environment)))
1005 (pass-if-syntax-error "(set! 1 #t)"
1008 (interaction-environment)))
1010 (pass-if-syntax-error "(set! #t #f)"
1013 (interaction-environment)))
1015 (pass-if-syntax-error "(set! #f #t)"
1018 (interaction-environment)))
1020 (pass-if-syntax-error "(set! #\\space #f)"
1022 (eval '(set! #\space #f)
1023 (interaction-environment)))))
1025 (with-test-prefix "quote"
1027 (with-test-prefix "missing or extra expression"
1029 (pass-if-syntax-error "(quote)"
1032 (interaction-environment)))
1034 (pass-if-syntax-error "(quote a b)"
1037 (interaction-environment)))))
1039 (with-test-prefix "while"
1041 (define (unreachable)
1042 (error "unreachable code has been reached!"))
1044 ;; Return a new procedure COND which when called (COND) will return #t the
1045 ;; first N times, then #f, then any further call is an error. N=0 is
1046 ;; allowed, in which case #f is returned by the first call.
1047 (define (make-iterations-cond n)
1050 (error "oops, condition re-tested after giving false"))
1059 (pass-if-syntax-error "too few args" exception:generic-syncase-error
1060 (eval '(while) (interaction-environment)))
1062 (with-test-prefix "empty body"
1066 (eval `(letrec ((make-iterations-cond
1070 (error "oops, condition re-tested after giving false"))
1077 (let ((cond (make-iterations-cond ,n)))
1080 (interaction-environment)))))
1082 (pass-if "initially false"
1087 (with-test-prefix "iterations"
1091 (let ((cond (make-iterations-cond n))
1097 (with-test-prefix "break"
1099 (pass-if "normal return"
1100 (not (while #f (error "not reached"))))
1105 (pass-if "multiple values"
1108 (lambda () (while #t (break 1 2 3)))
1111 (with-test-prefix "from cond"
1122 (let ((cond (make-iterations-cond n))
1132 (with-test-prefix "from body"
1142 (let ((cond (make-iterations-cond n))
1152 (pass-if "from nested"
1154 (let ((outer-break break))
1161 (pass-if "from recursive"
1162 (let ((outer-break #f))
1167 (set! outer-break break)
1173 (error "broke only from inner loop")))
1177 (with-test-prefix "continue"
1179 (pass-if-syntax-error "too many args" exception:too-many-args
1182 (interaction-environment)))
1184 (with-test-prefix "from cond"
1188 (let ((cond (make-iterations-cond n))
1199 (with-test-prefix "from body"
1203 (let ((cond (make-iterations-cond n))
1211 (pass-if "from nested"
1212 (let ((cond (make-iterations-cond 3)))
1214 (let ((outer-continue continue))
1220 (pass-if "from recursive"
1221 (let ((outer-continue #f))
1223 (let ((cond (make-iterations-cond 3))
1226 (if (and (not first)
1228 (error "continued only to inner loop"))
1233 (set! outer-continue continue)