fix R6RS syntax->datum and fix broken tests (as reported by Will)

svn: r10924

collects/rnrs/syntax-case-6.ss

@@ -72,18 +72,20 @@
      [(vector? d) (for-each loop (vector->list d))]))
   (datum->syntax id (convert-mpairs datum)))
 
-(define (r6rs:syntax->datum stx)
-  (cond
-   [(syntax? stx)
-    (convert-pairs (syntax->datum stx))]
-   [(mpair? stx) (mcons (r6rs:syntax->datum
-                         (mcar stx))
-                        (r6rs:syntax->datum
-                         (mcdr stx)))]
-   [(vector? stx) (list->vector
-                   (map r6rs:syntax->datum
-                        (vector->list stx)))]
-   [else stx]))
+(define (r6rs:syntax->datum orig-stx)
+  (let loop ([stx orig-stx])
+    (cond
+     [(syntax? stx)
+      (convert-pairs (syntax->datum stx))]
+     [(mpair? stx) (mcons (loop (mcar stx))
+                          (loop (mcdr stx)))]
+     [(vector? stx) (list->vector
+                     (map loop (vector->list stx)))]
+     [(symbol? stx) (raise-type-error 
+                     'syntax->datum 
+                     (format "syntax (symbol '~s disallowed)" stx)
+                     orig-stx)]
+     [else stx])))
 
 (define (r6rs:generate-temporaries l)
   (list->mlist

collects/tests/r6rs/syntax-case.sls

@@ -228,7 +228,7 @@
     (test (syntax->datum '(1 2)) '(1 2))
     (test (syntax->datum (cons #'a #'b)) '(a . b))
     (test (syntax->datum (vector #'a #'b)) '#(a b))
-    (test (syntax->datum '#(a b)) '#(a b))
+    (test (syntax->datum '#(1 2)) '#(1 2))
 
     (test (syntax->datum (datum->syntax #'x 1)) 1)
     (test (syntax->datum (datum->syntax #'x 'a)) 'a)