some r6rs test suite fixes

svn: r10857

collects/tests/r6rs/base.sls

@@ -177,6 +177,11 @@
                      (foo (+ x 3))))
           45)
 
+    (test/exn (letrec ([x y]
+                       [y x])
+                'should-not-get-here)
+              &assertion)
+
     ;; 11.4.1
     ;; (These tests are especially silly, since they really
     ;;  have to work to get this far.)

collects/tests/r6rs/exceptions.sls

@@ -72,6 +72,20 @@
     (test/exn (with-exception-handler (lambda (x) 0)
                                       (lambda () (error #f "bad")))
               &non-continuable)
+
+    
+    (let ([v '()])
+      (test (guard (exn [(equal? exn 5) 'five])
+                   ;; `guard' should jump back in before re-raising
+                   (guard (exn [(equal? exn 6) 'six])
+                          (dynamic-wind
+                              (lambda () (set! v (cons 'in v)))
+                              (lambda () (raise 5))
+                              (lambda () (set! v (cons 'out v))))))
+            'five)
+      (test v '(out in out in)))
+      
+
       
     ;;
     ))

collects/tests/r6rs/syntax-case.sls

@@ -268,7 +268,6 @@
             [(x ...) #`(x ...)])
           '(1 2 3))
 
-
     (test (unwrap
            #`(1 2 (unsyntax 3 4 5) 6))
           '(1 2 3 4 5 6))
@@ -279,7 +278,6 @@
     (test (unwrap
            #`#(1 2 (unsyntax-splicing '(3 4) '(5)) 6))
           '#(1 2 3 4 5 6))
-
     (test (unwrap
            #`(1 #`(#,(+ 3 4) #,#,(+ 1 1))))
           '(1 #`(#,(+ 3 4) #,2)))

collects/tests/r6rs/test.sls

@@ -107,7 +107,9 @@
     (unless (if (and (real? expected)
                      (nan? expected))
                 (nan? got)
-                (equal? got expected))
+                (or (equal? got expected)
+                    (and (expected-exception? expected)
+                         (expected-exception? got))))
       (set! failures
             (cons (list expr got expected)
                   failures))))

collects/tests/r6rs/unicode.sls

@@ -98,6 +98,11 @@
     (test (string-titlecase "r6rs") "R6Rs")
     (test (string-titlecase "R6RS") "R6Rs")
 
+    (test (string-downcase "A\x3A3;'x") "a\x3C3;'x") ; ' is a MidLetter
+
+    ;; There should be a test here that fails on PLT Scheme based on word-breaking
+    ;; according to Unicode Annex 29 --- but I can't figure out out.
+
     (test (string-ci<? "a" "Z") #t)
     (test (string-ci<? "A" "z") #t)
     (test (string-ci<? "Z" "a") #f)