/[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.15 by dirk, Tue Oct 7 22:00:05 2003 UTC revision 1.16 by dirk, Sat Oct 11 00:57:25 2003 UTC
# Line 20  Line 20 
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
# Line 30  Line 33 
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    
# Line 472  Line 483 
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))))
# Line 494  Line 509 
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    
# Line 542  Line 564 
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    

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

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