20 |
(define-module (test-suite test-syntax) |
(define-module (test-suite test-syntax) |
21 |
:use-module (test-suite lib)) |
:use-module (test-suite lib)) |
22 |
|
|
23 |
|
|
24 |
|
(define exception:bad-expression |
25 |
|
(cons 'syntax-error "Bad expression")) |
26 |
(define exception:bad-bindings |
(define exception:bad-bindings |
27 |
(cons 'misc-error "^bad bindings")) |
(cons 'misc-error "^bad bindings")) |
28 |
(define exception:duplicate-bindings |
(define exception:duplicate-bindings |
33 |
(cons 'misc-error "^bad formals")) |
(cons 'misc-error "^bad formals")) |
34 |
(define exception:duplicate-formals |
(define exception:duplicate-formals |
35 |
(cons 'misc-error "^duplicate formals")) |
(cons 'misc-error "^duplicate formals")) |
36 |
|
(define exception:missing-clauses |
37 |
|
(cons 'syntax-error "Missing clauses")) |
38 |
(define exception:bad-var |
(define exception:bad-var |
39 |
(cons 'misc-error "^bad variable")) |
(cons 'misc-error "^bad variable")) |
40 |
(define exception:bad/missing-clauses |
(define exception:bad/missing-clauses |
41 |
(cons 'misc-error "^bad or missing clauses")) |
(cons 'misc-error "^bad or missing clauses")) |
42 |
|
(define exception:bad-case-clause |
43 |
|
(cons 'syntax-error "Bad case clause")) |
44 |
|
(define exception:extra-case-clause |
45 |
|
(cons 'syntax-error "Extra case clause")) |
46 |
|
(define exception:bad-case-labels |
47 |
|
(cons 'syntax-error "Bad case labels")) |
48 |
(define exception:missing/extra-expr |
(define exception:missing/extra-expr |
49 |
(cons 'misc-error "^missing or extra expression")) |
(cons 'misc-error "^missing or extra expression")) |
50 |
|
|
483 |
|
|
484 |
(with-test-prefix "cond is hygienic" |
(with-test-prefix "cond is hygienic" |
485 |
|
|
486 |
|
(expect-fail "bound 'else is handled correctly" |
487 |
|
(false-if-exception |
488 |
|
(eq? (let ((else 'ok)) (cond (else))) 'ok))) |
489 |
|
|
490 |
(expect-fail "bound '=> is handled correctly" |
(expect-fail "bound '=> is handled correctly" |
491 |
(false-if-exception |
(false-if-exception |
492 |
(eq? (let ((=> #f)) (cond (#t => 'ok))) 'ok)))) |
(eq? (let ((=> #f)) (cond (#t => 'ok))) 'ok)))) |
509 |
|
|
510 |
(with-test-prefix "case" |
(with-test-prefix "case" |
511 |
|
|
512 |
|
(with-test-prefix "case is hygienic" |
513 |
|
|
514 |
|
(pass-if-exception "bound 'else is handled correctly" |
515 |
|
exception:bad-case-labels |
516 |
|
(eval '(let ((else #f)) (case 1 (else #f))) |
517 |
|
(interaction-environment)))) |
518 |
|
|
519 |
(with-test-prefix "bad or missing clauses" |
(with-test-prefix "bad or missing clauses" |
520 |
|
|
521 |
(pass-if-exception "(case)" |
(pass-if-exception "(case)" |
522 |
exception:bad/missing-clauses |
exception:missing-clauses |
523 |
(eval '(case) |
(eval '(case) |
524 |
(interaction-environment))) |
(interaction-environment))) |
525 |
|
|
526 |
(pass-if-exception "(case . \"foo\")" |
(pass-if-exception "(case . \"foo\")" |
527 |
exception:bad/missing-clauses |
exception:bad-expression |
528 |
(eval '(case . "foo") |
(eval '(case . "foo") |
529 |
(interaction-environment))) |
(interaction-environment))) |
530 |
|
|
531 |
(pass-if-exception "(case 1)" |
(pass-if-exception "(case 1)" |
532 |
exception:bad/missing-clauses |
exception:missing-clauses |
533 |
(eval '(case 1) |
(eval '(case 1) |
534 |
(interaction-environment))) |
(interaction-environment))) |
535 |
|
|
536 |
(pass-if-exception "(case 1 . \"foo\")" |
(pass-if-exception "(case 1 . \"foo\")" |
537 |
exception:bad/missing-clauses |
exception:bad-expression |
538 |
(eval '(case 1 . "foo") |
(eval '(case 1 . "foo") |
539 |
(interaction-environment))) |
(interaction-environment))) |
540 |
|
|
541 |
(pass-if-exception "(case 1 \"foo\")" |
(pass-if-exception "(case 1 \"foo\")" |
542 |
exception:bad/missing-clauses |
exception:bad-case-clause |
543 |
(eval '(case 1 "foo") |
(eval '(case 1 "foo") |
544 |
(interaction-environment))) |
(interaction-environment))) |
545 |
|
|
546 |
(pass-if-exception "(case 1 ())" |
(pass-if-exception "(case 1 ())" |
547 |
exception:bad/missing-clauses |
exception:bad-case-clause |
548 |
(eval '(case 1 ()) |
(eval '(case 1 ()) |
549 |
(interaction-environment))) |
(interaction-environment))) |
550 |
|
|
551 |
(pass-if-exception "(case 1 (\"foo\"))" |
(pass-if-exception "(case 1 (\"foo\"))" |
552 |
exception:bad/missing-clauses |
exception:bad-case-clause |
553 |
(eval '(case 1 ("foo")) |
(eval '(case 1 ("foo")) |
554 |
(interaction-environment))) |
(interaction-environment))) |
555 |
|
|
556 |
(pass-if-exception "(case 1 (\"foo\" \"bar\"))" |
(pass-if-exception "(case 1 (\"foo\" \"bar\"))" |
557 |
exception:bad/missing-clauses |
exception:bad-case-labels |
558 |
(eval '(case 1 ("foo" "bar")) |
(eval '(case 1 ("foo" "bar")) |
559 |
(interaction-environment))) |
(interaction-environment))) |
560 |
|
|
564 |
;; (case 1 (() "bar"))) |
;; (case 1 (() "bar"))) |
565 |
|
|
566 |
(pass-if-exception "(case 1 ((2) \"bar\") . \"foo\")" |
(pass-if-exception "(case 1 ((2) \"bar\") . \"foo\")" |
567 |
exception:bad/missing-clauses |
exception:bad-expression |
568 |
(eval '(case 1 ((2) "bar") . "foo") |
(eval '(case 1 ((2) "bar") . "foo") |
569 |
(interaction-environment))) |
(interaction-environment))) |
570 |
|
|
571 |
(pass-if-exception "(case 1 ((2) \"bar\") (else))" |
(pass-if-exception "(case 1 ((2) \"bar\") (else))" |
572 |
exception:bad/missing-clauses |
exception:bad-case-clause |
573 |
(eval '(case 1 ((2) "bar") (else)) |
(eval '(case 1 ((2) "bar") (else)) |
574 |
(interaction-environment))) |
(interaction-environment))) |
575 |
|
|
576 |
(pass-if-exception "(case 1 (else #f) . \"foo\")" |
(pass-if-exception "(case 1 (else #f) . \"foo\")" |
577 |
exception:bad/missing-clauses |
exception:bad-expression |
578 |
(eval '(case 1 (else #f) . "foo") |
(eval '(case 1 (else #f) . "foo") |
579 |
(interaction-environment))) |
(interaction-environment))) |
580 |
|
|
581 |
(pass-if-exception "(case 1 (else #f) ((1) #t))" |
(pass-if-exception "(case 1 (else #f) ((1) #t))" |
582 |
exception:bad/missing-clauses |
exception:extra-case-clause |
583 |
(eval '(case 1 (else #f) ((1) #t)) |
(eval '(case 1 (else #f) ((1) #t)) |
584 |
(interaction-environment))))) |
(interaction-environment))))) |
585 |
|
|