From f2a3317df67e2e53f9169af8a4f7097c96420e40 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Fri, 25 Apr 2008 20:10:13 +0000
Subject: [PATCH] more r6rs tests

svn: r9479
---
 collects/rnrs/base-6.ss            |  29 +--
 collects/tests/r6rs/base.ss        | 278 ++++++++++++++++++++++++++++-
 collects/tests/r6rs/bytevectors.ss | 108 ++++++++++-
 collects/tests/r6rs/unicode.ss     |  58 ++++++
 4 files changed, 457 insertions(+), 16 deletions(-)

diff --git a/collects/rnrs/base-6.ss b/collects/rnrs/base-6.ss
index a45ed94954..5550e18379 100644
--- a/collects/rnrs/base-6.ss
+++ b/collects/rnrs/base-6.ss
@@ -302,16 +302,18 @@
   (and (regexp-match? rx:number s)
        (string->number (regexp-replace* #rx"[|][0-9]+" s "") radix)))
 
-(define-syntax-rule (make-mapper what for for-each in-val val-length val->list)
+(define-syntax-rule (make-mapper what for for-each in-val val-length val->list list->result)
   (case-lambda
-   [(proc val) (for ([c (in-val val)])
-                 (proc c))]
+   [(proc val) (list->result
+                (for ([c (in-val val)])
+                  (proc c)))]
    [(proc val1 val2) 
     (if (= (val-length val1)
            (val-length val2))
-        (for ([c1 (in-val val1)]
-              [c2 (in-val val2)])
-          (proc c1 c2))
+        (list->result
+         (for ([c1 (in-val val1)]
+               [c2 (in-val val2)])
+           (proc c1 c2)))
         (error 'val-for-each "~as have different lengths: ~e and: ~e"
                what
                val1 val2))]
@@ -323,19 +325,20 @@
                            what
                            val1 s)))
                 vals)
-      (apply for-each 
-             proc 
-             (val->list val1)
-             (map val->list vals)))]))
+      (list->result
+       (apply for-each
+              proc 
+              (val->list val1)
+              (map val->list vals))))]))
 
 (define string-for-each
-  (make-mapper "string" for for-each in-string string-length string->list))
+  (make-mapper "string" for for-each in-string string-length string->list void))
 
 (define vector-for-each
-  (make-mapper "vector" for for-each in-vector vector-length vector->list))
+  (make-mapper "vector" for for-each in-vector vector-length vector->list void))
 
 (define vector-map
-  (make-mapper "vector" for/list map in-vector vector-length vector->list))
+  (make-mapper "vector" for/list map in-vector vector-length vector->list list->vector))
 
 
 (define (r6rs:error who msg . irritants)
diff --git a/collects/tests/r6rs/base.ss b/collects/tests/r6rs/base.ss
index 883f75e24e..c07fe9ad40 100644
--- a/collects/tests/r6rs/base.ss
+++ b/collects/tests/r6rs/base.ss
@@ -460,6 +460,41 @@
     (test (exact? 5)                    #t)
     (test (inexact? +inf.0)             #t)
 
+    (test (inexact 2) 2.0)
+    (test (inexact 2.0) 2.0)
+    (test (exact 2) 2)
+    (test (exact 2.0) 2)
+
+    (for-each
+     (lambda (x y)
+       (let ([try-one
+              (lambda (x y)
+                (let ([try-x
+                       (lambda (x x2)
+                         (test (= x x2) #t)
+                         (test (< x x2) #f)
+                         (test (> x x2) #f)
+                         (test (<= x x2) #t)
+                         (test (>= x x2) #t))])
+                  (try-x x x)
+                  (when (exact? x)
+                    (try-x x (inexact x))
+                    (try-x (inexact x) x)))
+                (test (< x y) #t)
+                (test (<= x y) #t)
+                (test (> x y) #f)
+                (test (>= x y) #f)
+                (test (< y x) #f)
+                (test (<= y x) #f)
+                (test (> y x) #t)
+                (test (>= y x) #t))])
+         (try-one x y)
+         (try-one (inexact x) y)
+         (try-one x (inexact y))
+         (try-one (inexact x) (inexact y))))
+     (list 1/2 1 3/2 (expt 2 100) (expt 2 100))
+     (list 1 2 51/20 (expt 2 102) (/ (* 4 (expt 2 100)) 3)))
+
     (test (= +inf.0 +inf.0)            #t)
     (test (= -inf.0 +inf.0)            #f)
     (test (= -inf.0 -inf.0)            #t)
@@ -483,16 +518,35 @@
 
     (test (zero? +0.0)                   #t)
     (test (zero? -0.0)                   #t)
+    (test (zero? 2.0)                    #f)
+    (test (zero? -2.0)                   #f)
     (test (zero? +nan.0)                 #f)
+    (test (positive? 10)                 #t)
+    (test (positive? -10)                #f)
     (test (positive? +inf.0)             #t)
     (test (negative? -inf.0)             #t)
     (test (positive? +nan.0)             #f)
+    (test (negative? 10)                 #f)
+    (test (negative? -10)                #t)
     (test (negative? +nan.0)             #f)
     (test (finite? +inf.0)               #f)
     (test (finite? 5)                    #t)
     (test (finite? 5.0)                  #t)
     (test (infinite? 5.0)                #f)
     (test (infinite? +inf.0)             #t)
+    (test (nan? +nan.0)                  #t)
+    (test (nan? +inf.0)                  #f)
+    (test (nan? 1020.0)                  #f)
+    (test (nan? 1020/3)                  #f)
+
+    (test (odd? 5) #t)
+    (test (odd? 50) #f)
+    (test (odd? 5.0) #t)
+    (test (odd? 50.0) #f)
+    (test (even? 5) #f)
+    (test (even? 50) #t)
+    (test (even? 5.0) #f)
+    (test (even? 50.0) #t)
 
     (test (max 3 4)                               4)
     (test (max 3.9 4)                             4.0)
@@ -506,10 +560,13 @@
     (test (+ 3 4)                                 7)
     (test (+ 3)                                   3)
     (test (+)                                     0)
+    (test (+ 3.0 4)                               7.0)
     (test (+ +inf.0 +inf.0)                       +inf.0)
     (test (+ +inf.0 -inf.0)                       +nan.0)
 
     (test (* 4)                                   4)
+    (test (* 4 3)                                 12)
+    (test (* 4 3.0)                               12.0)
     (test (*)                                     1)
     (test (* 5 +inf.0)                            +inf.0)
     (test (* -5 +inf.0)                           -inf.0)
@@ -553,6 +610,8 @@
     (test (- -0.0 -0.0) 0.0)
     
     (test (/ 3 4 5)                               3/20)
+    (test (/ 2 3)                                 2/3)
+    (test (/ 3 2.0)                               1.5)
     (test (/ 3)                                   1/3)
     (test (/ 0.0)                                 +inf.0)
     (test (/ 1.0 0)                               +inf.0)
@@ -566,7 +625,9 @@
     (test (/ 0.0 0)                               +nan.0)
     (test (/ 0.0 0.0)                             +nan.0)
 
+    (test (abs 7)                                 7)
     (test (abs -7)                                7)
+    (test (abs (- (expt 2 100)))                  (expt 2 100))
     (test (abs -inf.0)                            +inf.0)
 
     (test (div 123 10) 12)
@@ -713,8 +774,10 @@
     (test (lcm 32.0 -36)                          288.0)
     (test (lcm)                                   1)
     
+    (test (numerator 6)                           6)
     (test (numerator (/ 6 4))                     3)
     (test (denominator (/ 6 4))                   2)
+    (test (denominator 6)                         1)
     (test (denominator (inexact (/ 6 4))) 2.0)
 
     (test (floor -4.3)                            -5.0)
@@ -741,8 +804,10 @@
     (test (rationalize +inf.0 +inf.0)             +nan.0)
     (test (rationalize 3 +inf.0)                  0.0)
 
+    (test/approx (exp 1)    2.718281828459045)
     (test (exp +inf.0)                   +inf.0)
     (test (exp -inf.0)                   0.0)
+    (test/approx (log 2.718281828459045) 1.0)
     (test (log +inf.0)                   +inf.0)
     (test (log 0.0)                      -inf.0)
 
@@ -754,11 +819,13 @@
     (test/approx (log -1.0+0.0i) 0.0+3.141592653589793i)
     (test/approx (log -1.0-0.0i) 0.0-3.141592653589793i)
 
+    (test/approx (sqrt 5) 2.23606797749979)
     (test/approx (sqrt -5) 0.0+2.23606797749979i)
 
     (test (sqrt +inf.0)                +inf.0)
     (test (sqrt -inf.0)                +inf.0i)
 
+    (test/values (exact-integer-sqrt 0) 0 0)
     (test/values (exact-integer-sqrt 4) 2 0)
     (test/values (exact-integer-sqrt 5) 2 1)
     
@@ -773,7 +840,9 @@
     (test (expt 0.0 0.0)               1.0)
     
     
+    (test/approx (make-rectangular 1.1 0.0) 1.1+0.0i)
     (test/approx (make-rectangular 1.1 2.2) 1.1+2.2i)
+    (test/approx (make-polar 1.1 0.0) 1.1+0.0i)
     (test/approx (make-polar 1.1 2.2) 1.1@2.2)
 
     (test/approx (real-part 1.1+2.2i)              1.1)
@@ -795,6 +864,22 @@
 
     (test/approx (angle -1)   3.141592653589793)
 
+    (for-each 
+     (lambda (n)
+       (test (string->number (number->string n)) n)
+       (test (string->number (number->string n 10 5)) n)
+       (when (exact? n)
+         (test (string->number (number->string n 16) 16) n)
+         (test (string->number (string-append "#x" (number->string n 16))) n)
+         (test (string->number (number->string n 8) 8) n)
+         (test (string->number (string-append "#o" (number->string n 8))) n)
+         (test (string->number (number->string n 2) 2) n)
+         (test (string->number (string-append "#b" (number->string n 2))) n)
+         (test (string->number (number->string n 10) 10) n)
+         (test (string->number (string-append "#d" (number->string n 10))) n)))
+     '(1 2.0 1/2 2e200 1+2i))
+    (test (string->number "nope") #f)
+
     (test (string->number "100")                  100)
     (test (string->number "100" 16)               256)
     (test (string->number "1e2")                  100.0)
@@ -884,6 +969,41 @@
     (test (cdr '(1 . 2))           2)
     (test/exn (cdr '()) &assertion)
 
+    (test (cadr '(1 2)) 2)
+    (test (cddr '(1 2)) '())
+    (test (cdar '((1) 2)) '())
+    (test (caar '((1) 2)) 1)
+
+    (test (cadar '((1 2))) 2)
+    (test (cddar '((1 2))) '())
+    (test (cdaar '(((1) 2))) '())
+    (test (caaar '(((1) 2))) 1)
+    (test (caddr '(0 1 2)) 2)
+    (test (cdddr '(0 1 2)) '())
+    (test (cdadr '(0 (1) 2)) '())
+    (test (caadr '(0 (1) 2)) 1)
+
+    (test (cadaar '(((1 2)))) 2)
+    (test (cddaar '(((1 2)))) '())
+    (test (cdaaar '((((1) 2)))) '())
+    (test (caaaar '((((1) 2)))) 1)
+    (test (caddar '((0 1 2))) 2)
+    (test (cdddar '((0 1 2))) '())
+    (test (cdadar '((0 (1) 2))) '())
+    (test (caadar '((0 (1) 2))) 1)
+    (test (cadadr '(- (1 2))) 2)
+    (test (cddadr '(- (1 2))) '())
+    (test (cdaadr '(- ((1) 2))) '())
+    (test (caaadr '(- ((1) 2))) 1)
+    (test (cadddr '(- 0 1 2)) 2)
+    (test (cddddr '(- 0 1 2)) '())
+    (test (cdaddr '(- 0 (1) 2)) '())
+    (test (caaddr '(- 0 (1) 2)) 1)
+
+    (test (null? '())           #t)
+    (test (null? '(1))          #f)
+    (test (null? #f)            #f)
+
     (test (list? '(a b c))      #t)
     (test (list? '())           #t)
     (test (list? '(a . b))      #f)
@@ -905,8 +1025,10 @@
     (test (reverse '(a (b c) d (e (f))))   '((e (f)) d (b c) a))
 
     (test (list-tail '(a b c d) 2)                  '(c d))
+    (test (list-tail '(a b . c) 2)                  'c)
 
     (test (list-ref '(a b c d) 2)                 'c)
+    (test (list-ref '(a b c . d) 2)                 'c)
 
     (test (map cadr '((a b) (d e) (g h)))    '(b e h))
 
@@ -942,6 +1064,10 @@
     (test (symbol? 'nil)           #t)
     (test (symbol? '())            #f)
     (test (symbol? #f)      #f)
+
+    (test (symbol=? 'a 'a)         #t)
+    (test (symbol=? 'a 'A)         #f)
+    (test (symbol=? 'a 'b)         #f)
     
     (test (symbol->string 'flying-fish)     
           "flying-fish")
@@ -963,21 +1089,116 @@
           #t)
 
     ;; 11.11
+    (test (char? #\a) #t)
+    (test (char? 'a) #f)
+    (test (char? 65) #f)
+    
     (test (integer->char 32) #\space)
+    (test (integer->char #xDF) #\xDF)
+    (test (integer->char #x10AAAA) #\x10AAAA)
     (test (char->integer (integer->char 5000))
           5000)
     (test/exn (integer->char #xD800) &assertion)
+    (test (char=? #\z #\xDF) #f)
+    (test (char=? #\z #\z) #t)
+    (test (char<? #\z #\z) #f)
     (test (char<? #\z #\xDF) #t)
+    (test (char<? #\xDF #\z) #f)
     (test (char<? #\z #\Z) #f)
+    (test (char<=? #\z #\z) #t)
+    (test (char<=? #\z #\xDF) #t)
+    (test (char<=? #\xDF #\z) #f)
+    (test (char<=? #\z #\Z) #f)
+    (test (char>? #\z #\z) #f)
+    (test (char>? #\z #\xDF) #f)
+    (test (char>? #\xDF #\z) #t)
+    (test (char>? #\z #\Z) #t)
+    (test (char>=? #\z #\z) #t)
+    (test (char>=? #\z #\xDF) #f)
+    (test (char>=? #\xDF #\z) #t)
+    (test (char>=? #\z #\Z) #t)
 
     ;; 11.12
-    (test (string=? "Stra\xDF;e" "Strasse") #f)
+    (test (string? "apple") #t)
+    (test (string? #vu8(1 2)) #f)
+    (test (string? #\a) #f)
+    (test (string? 77) #f)
 
+    (test (string-length (make-string 10)) 10)
+    (test (string-length (make-string 10 #\a)) 10)
+    (test (string-ref (make-string 10 #\a) 0) #\a)
+    (test (string-ref (make-string 10 #\a) 5) #\a)
+    (test (string-ref (make-string 10 #\a) 9) #\a)
+
+    (test (string=? "Strasse" "Strasse") #t)
+    (test (string=? "Stra\xDF;e" "Strasse") #f)
+    (test (string=? "Strasse" "Strasse" "Stra\xDF;e") #f)
+    (test (string=? "Strasse" "Stra\xDF;e" "Strasse") #f)
+    (test (string=? "Stra\xDF;e" "Strasse" "Strasse") #f)
+    (test (string=? "Strasse" "Strasse" "Strasse") #t)
+
+    (test (string<? "z" "z") #f)
     (test (string<? "z" "\xDF;") #t)
+    (test (string<? "\xDF;" "z") #f)
     (test (string<? "z" "zz") #t)
     (test (string<? "z" "Z") #f)
+    (test (string<=? "z" "\xDF;") #t)
+    (test (string<=? "\xDF;" "z") #f)
+    (test (string<=? "z" "zz") #t)
+    (test (string<=? "z" "Z") #f)
+    (test (string<=? "z" "z") #t)
+
+    (test (string<? "z" "z") #f)
+    (test (string>? "z" "\xDF;") #f)
+    (test (string>? "\xDF;" "z") #t)
+    (test (string>? "z" "zz") #f)
+    (test (string>? "z" "Z") #t)
+    (test (string>=? "z" "\xDF;") #f)
+    (test (string>=? "\xDF;" "z") #t)
+    (test (string>=? "z" "zz") #f)
+    (test (string>=? "z" "Z") #t)
+    (test (string>=? "z" "z") #t)
+
+    (test (substring "apple" 0 3) "app")
+    (test (substring "apple" 1 3) "pp")
+    (test (substring "apple" 3 5) "le")
+
+    (test (string-append "apple") "apple")
+    (test (string-append "apple" "banana") "applebanana")
+    (test (string-append "apple" "banana" "cherry") "applebananacherry")
+
+    (test (string->list "apple") (list #\a #\p #\p #\l #\e))
+    (test (list->string (list #\a #\p #\p #\l #\e)) "apple")
+
+    (let ([accum '()])
+      (test/unspec (string-for-each (lambda (a) (set! accum (cons a accum)))
+                                    "elppa"))
+      (test accum '(#\a #\p #\p #\l #\e))
+      (test/unspec (string-for-each (lambda (a b) (set! accum (cons (list a b) accum)))
+                                    "elppa"
+                                    "ananb"))
+      (test accum '((#\a #\b) (#\p #\n) (#\p #\a) (#\l #\n) (#\e #\a)
+                    #\a #\p #\p #\l #\e))
+      (test/unspec (string-for-each (lambda (a b c) (set! accum c))
+                                    "elppa"
+                                    "ananb"
+                                    "chery"))
+      (test accum #\y))
+
+    (test "apple" (string-copy "apple"))
+    (let ([s "apple"])
+      (test (eq? s (string-copy s)) #f))
 
     ;; 11.13
+    (test (vector? '#(1 2 3)) #t)
+    (test (vector? "apple") #f)
+
+    (test (vector-length (make-vector 10)) 10)
+    (test (vector-length (make-vector 10 'x)) 10)
+    (test (vector-ref (make-vector 10 'x) 0) 'x)
+    (test (vector-ref (make-vector 10 'x) 5) 'x)
+    (test (vector-ref (make-vector 10 'x) 9) 'x)
+
     (test '#(0 (2 2 2 2) "Anna")  (vector 0 '(2 2 2 2) "Anna"))
     (test (vector 'a 'b 'c)       '#(a b c))
     (test (vector-ref '#(1 1 2 3 5 8 13 21) 5)   8)
@@ -992,10 +1213,53 @@
     (test (vector->list '#(dah dah didah))  '(dah dah didah))
     (test (list->vector '(dididit dah))     '#(dididit dah))
 
+    (let ([vec (vector 'x 'y 'z)])
+      (vector-fill! vec 10.1)
+      (test vec '#(10.1 10.1 10.1)))
+
+    (test (vector-map (lambda (x) (+ 1 x)) 
+                      '#(1 2 3))
+          '#(2 3 4))
+    (test (vector-map (lambda (x y) (- x y)) 
+                      '#(3 4 5) 
+                      '#(0 -1 2))
+          '#(3 5 3))
+    (test (vector-map (lambda (x y f) (f (- x y)))
+                      '#(3 4 5) 
+                      '#(0 -1 2)
+                      (vector - * /))
+          '#(-3 5 1/3))
+
+    (let ([accum '()])
+      (test/unspec (vector-for-each (lambda (a) (set! accum (cons a accum)))
+                                    '#(e l p p a)))
+      (test accum '(a p p l e))
+      (test/unspec (vector-for-each (lambda (a b) (set! accum (cons (list a b) accum)))
+                                    '#(e l p p a)
+                                    '#(a n a n b)))
+      (test accum '((a b) (p n) (p a) (l n) (e a)
+                    a p p l e))
+      (test/unspec (vector-for-each (lambda (a b c) (set! accum c))
+                                    '#(e l p p a)
+                                    '#(a n a n b)
+                                    '#(c h e r y)))
+      (test accum 'y))
+
     ;; 11.14
+    (for-each
+     (lambda (error)
+       (test/exn (error 'apple "bad" 'worm) &who)
+       (test/exn (error #f "bad" 'worm) &message)
+       (test/exn (error 'apple "bad" 'worm) &irritants)
+       (test/exn (error 'apple "bad") &irritants))
+     (list error assertion-violation))
+    (test/exn (error 'apple "bad" 'worm) &error)
+    (test/exn (assertion-violation 'apple "bad" 'worm) &assertion)
+
     (test (fac 5) 120)
     (test/exn (fac 4.5) &assertion)
     (test/exn (fac -3) &assertion)
+    (test/exn (fac -3) &message)
 
     ;; 11.15
     (test (apply + (list 3 4))               7)
@@ -1009,11 +1273,23 @@
                        '(54 0 37 -3 245 19))
              #t))
           -3)
+    (test (call/cc
+           (lambda (exit)
+             (for-each (lambda (x)
+                         (if (negative? x)
+                             (exit x)))
+                       '(54 0 37 -3 245 19))
+             #t))
+          -3)
 
     (test (list-length '(1 2 3 4))             4)
 
     (test (list-length '(a b . c))             #f)
 
+    (test/values (values))
+    (test (values 1) 1)
+    (test/values (values 1 2 3) 1 2 3)
+
     (test (call-with-current-continuation procedure?) #t)
 
     (test (call-with-values (lambda () (values 4 5))
diff --git a/collects/tests/r6rs/bytevectors.ss b/collects/tests/r6rs/bytevectors.ss
index 0b40b9f5c0..19198af649 100644
--- a/collects/tests/r6rs/bytevectors.ss
+++ b/collects/tests/r6rs/bytevectors.ss
@@ -8,13 +8,40 @@
   (define (run-bytevectors-tests)
     
     ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-    ;; Tests originally from R6RS
+    ;; Tests originally from R6RS, plus added
+
+    (test (endianness little) 'little)
+    (test (endianness big) 'big)
+    (test (symbol? (native-endianness)) #t)
+
+    (test (bytevector? #vu8(1 2 3)) #t)
+    (test (bytevector? "123") #f)
+
+    (test (bytevector-length #vu8(1 2 3)) 3)
+    (test (bytevector-length (make-bytevector 10)) 10)
+    (test (bytevector-length (make-bytevector 10 3)) 10)
+    (test (bytevector-u8-ref (make-bytevector 10 3) 0) 3)
+    (test (bytevector-u8-ref (make-bytevector 10 3) 5) 3)
+    (test (bytevector-u8-ref (make-bytevector 10 3) 9) 3)
+    (test (bytevector-u8-ref (make-bytevector 10 255) 9) 255)
+    (test (bytevector-u8-ref (make-bytevector 10 -1) 9) 255)
+    (test (bytevector-u8-ref (make-bytevector 10 -128) 9) 128)
+
+    (let ([v (make-bytevector 5 2)])
+      (test/unspec (bytevector-fill! v -1))
+      (test v #vu8(255 255 255 255 255))
+      (test/unspec (bytevector-fill! v 17))
+      (test v #vu8(17 17 17 17 17))
+      (test/unspec (bytevector-fill! v 255))
+      (test v #vu8(255 255 255 255 255)))
     
     (test (let ((b (u8-list->bytevector '(1 2 3 4 5 6 7 8))))
             (bytevector-copy! b 0 b 3 4)
             (bytevector->u8-list b)) 
           '(1 2 3 1 2 3 4 8))
 
+    (test (bytevector-copy #vu8(1 2 3)) #vu8(1 2 3))
+
     (test (let ((b1 (make-bytevector 16 -127))
                 (b2 (make-bytevector 16 255)))
             (list
@@ -36,6 +63,11 @@
              (bytevector-u8-ref b 1)))
           '(-126 130 -10 246))
 
+    (test (bytevector->u8-list #vu8(1 2 3)) '(1 2 3))
+    (test (bytevector->u8-list #vu8(255 255 255)) '(255 255 255))
+    (test (u8-list->bytevector '(1 2 3)) #vu8(1 2 3))
+    (test (u8-list->bytevector '()) #vu8())
+
     (let ([b (make-bytevector 16 -127)])
       (test/unspec
        (bytevector-uint-set! b 0 (- (expt 2 128) 3)
@@ -104,7 +136,79 @@
       (test (bytevector-s64-ref b 8 (endianness little)) -144115188075855873)
       (test (bytevector-u64-ref b 8 (endianness big)) 18446744073709551613)
       (test (bytevector-s64-ref b 8 (endianness big)) -3))
-    
+
+    (for-each
+     (lambda (k)
+       (for-each
+        (lambda (n)
+          (let ([b (make-bytevector 12)])
+            (test/unspec (bytevector-ieee-single-native-set! b k n))
+            (test/approx (bytevector-ieee-single-native-ref b k) n))
+          (let ([b (make-bytevector 12)])
+            (test/unspec (bytevector-ieee-single-set! b k n 'big))
+            (test/approx (bytevector-ieee-single-ref b k 'big) n))
+          (let ([b (make-bytevector 12)])
+            (test/unspec (bytevector-ieee-single-set! b k n 'little))
+            (test/approx (bytevector-ieee-single-ref b k 'little) n))
+          (let ([b (make-bytevector 12)])
+            (test/unspec (bytevector-ieee-double-native-set! b k n))
+            (test/approx (bytevector-ieee-double-native-ref b k) n))
+          (let ([b (make-bytevector 12)])
+            (test/unspec (bytevector-ieee-double-set! b k n 'big))
+            (test/approx (bytevector-ieee-double-ref b k 'big) n))
+          (let ([b (make-bytevector 12)])
+            (test/unspec (bytevector-ieee-double-set! b k n 'little))
+            (test/approx (bytevector-ieee-double-ref b k 'little) n)))
+        '(1.0 25.78 +inf.0 -inf.0 +nan.0)))
+     '(0 1 2 3 4))
+
+    (test (string->utf8 "apple") #vu8(97 112 112 108 101))
+    (test (string->utf8 "app\x3BB;e") #vu8(97 112 112 206 187 101))
+    (test (string->utf16 "app\x3BB;e" 'little) #vu8(97 0 112 0 112 0 #xBB #x3 101 0))
+    (test (string->utf16 "app\x3BB;e" 'big) #vu8(0 97 0 112 0 112 #x3 #xBB 0 101))
+    (test (string->utf16 "app\x3BB;e") #vu8(0 97 0 112 0 112 #x3 #xBB 0 101))
+    (test (string->utf32 "app\x3BB;e" 'little) #vu8(97 0 0 0 112 0 0 0 112 0 0 0 #xBB #x3 0 0 101 0 0 0))
+    (test (string->utf32 "app\x3BB;e" 'big) #vu8(0 0 0 97 0 0 0 112 0 0 0 112 0 0 #x3 #xBB 0 0 0 101))
+    (test (string->utf32 "app\x3BB;e") #vu8(0 0 0 97 0 0 0 112 0 0 0 112 0 0 #x3 #xBB 0 0 0 101))
+
+    (let ([bv-append
+           (lambda (bv1 bv2)
+             (let ([bv (make-bytevector (+ (bytevector-length bv1)
+                                           (bytevector-length bv2)))])
+               (bytevector-copy! bv1 0 bv 0  (bytevector-length bv1))
+               (bytevector-copy! bv2 0 bv (bytevector-length bv1) (bytevector-length bv2))
+               bv))])
+      (for-each
+       (lambda (str)
+         (test (utf8->string (string->utf8 str)) str)
+         (test (utf16->string (string->utf16 str 'big) 'big) str)
+         (test (utf16->string (string->utf16 str 'little) 'little) str)
+         (test (utf16->string (bv-append #vu8(#xFF #xFE) (string->utf16 str 'little)) 'big) str)
+         (test (utf16->string (bv-append #vu8(#xFE #xFF) (string->utf16 str 'big)) 'little) str)
+         (test (utf16->string (bv-append #vu8(#xFF #xFE) (string->utf16 str 'little)) 'little #t) 
+               (string-append "\xFEFF;" str))
+         (test (utf16->string (bv-append #vu8(#xFE #xFF) (string->utf16 str 'little)) 'little #t) 
+               (string-append "\xFFFE;" str))
+         (test (utf16->string (bv-append #vu8(#xFE #xFF) (string->utf16 str 'big)) 'big #t) 
+               (string-append "\xFEFF;" str))
+         (test (utf16->string (bv-append #vu8(#xFF #xFE) (string->utf16 str 'big)) 'big #t) 
+               (string-append "\xFFFE;" str))
+         (test (utf32->string (string->utf32 str 'big) 'big) str)
+         (test (utf32->string (string->utf32 str 'little) 'little) str)
+         (test (utf32->string (bv-append #vu8(#xFF #xFE 0 0) (string->utf32 str 'little)) 'big) str)
+         (test (utf32->string (bv-append #vu8(0 0 #xFE #xFF) (string->utf32 str 'big)) 'little) str)
+         (test (utf32->string (bv-append #vu8(#xFF #xFE 0 0) (string->utf32 str 'little)) 'little #t) 
+               (string-append "\xFEFF;" str))
+         (test (utf32->string (bv-append #vu8(#xFE #xFF 0 0) (string->utf32 str 'little)) 'little #t) 
+               (string-append "\xFFFE;" str))
+         (test (utf32->string (bv-append #vu8(0 0 #xFE #xFF) (string->utf32 str 'big)) 'big #t) 
+               (string-append "\xFEFF;" str))
+         (test (utf32->string (bv-append #vu8(0 0 #xFF #xFE) (string->utf32 str 'big)) 'big #t) 
+               (string-append "\xFFFE;" str)))
+       (list "apple"
+             "app\x3BB;e"
+             "\x0;\x1;\x80;\xFF;\xD7FF;\xE000;\x10FFFF;")))
+
     ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     ;; Tests originally from Ikarus
 
diff --git a/collects/tests/r6rs/unicode.ss b/collects/tests/r6rs/unicode.ss
index af42ce5550..e752eb9aad 100644
--- a/collects/tests/r6rs/unicode.ss
+++ b/collects/tests/r6rs/unicode.ss
@@ -28,16 +28,41 @@
     (test (char-foldcase #\x3C2) #\x3C3)
 
     (test (char-ci<? #\z #\Z) #f)
+    (test (char-ci<? #\Z #\z) #f)
+    (test (char-ci<? #\a #\Z) #t)
+    (test (char-ci<? #\Z #\a) #f)
+    (test (char-ci<=? #\z #\Z) #t)
+    (test (char-ci<=? #\Z #\z) #t)
+    (test (char-ci<=? #\a #\Z) #t)
+    (test (char-ci<=? #\Z #\a) #f)
+    (test (char-ci=? #\z #\a) #f)
     (test (char-ci=? #\z #\Z) #t)
     (test (char-ci=? #\x3C2 #\x3C3) #t)
+    (test (char-ci>? #\z #\Z) #f)
+    (test (char-ci>? #\Z #\z) #f)
+    (test (char-ci>? #\a #\Z) #f)
+    (test (char-ci>? #\Z #\a) #t)
+    (test (char-ci>=? #\Z #\z) #t)
+    (test (char-ci>=? #\z #\Z) #t)
+    (test (char-ci>=? #\z #\Z) #t)
+    (test (char-ci>=? #\a #\z) #f)
 
     (test (char-alphabetic? #\a) #t)
+    (test (char-alphabetic? #\1) #f)
     (test (char-numeric? #\1) #t)
+    (test (char-numeric? #\a) #f)
     (test (char-whitespace? #\space) #t)
     (test (char-whitespace? #\x00A0) #t)
+    (test (char-whitespace? #\a) #f)
+    (test (char-upper-case? #\a) #f)
+    (test (char-upper-case? #\A) #t)
     (test (char-upper-case? #\x3A3) #t)
+    (test (char-lower-case? #\a) #t)
+    (test (char-lower-case? #\A) #f)
     (test (char-lower-case? #\x3C3) #t)
     (test (char-lower-case? #\x00AA) #t)
+    (test (char-title-case? #\a) #f)
+    (test (char-title-case? #\A) #f)
     (test (char-title-case? #\I) #f)
     (test (char-title-case? #\x01C5) #t)
 
@@ -46,8 +71,12 @@
     (test (char-general-category #\x10FFFF) 'Cn)
 
     (test (string-upcase "Hi") "HI")
+    (test (string-upcase "HI") "HI")
     (test (string-downcase "Hi") "hi")
+    (test (string-downcase "hi") "hi")
     (test (string-foldcase "Hi") "hi")
+    (test (string-foldcase "HI") "hi")
+    (test (string-foldcase "hi") "hi")
 
     (test (string-upcase "Stra\xDF;e") "STRASSE")
     (test (string-downcase "Stra\xDF;e") "stra\xDF;e")
@@ -69,17 +98,46 @@
     (test (string-titlecase "r6rs") "R6Rs")
     (test (string-titlecase "R6RS") "R6Rs")
 
+    (test (string-ci<? "a" "Z") #t)
+    (test (string-ci<? "A" "z") #t)
+    (test (string-ci<? "Z" "a") #f)
+    (test (string-ci<? "z" "A") #f)
     (test (string-ci<? "z" "Z") #f)
+    (test (string-ci<? "Z" "z") #f)
+    (test (string-ci>? "a" "Z") #f)
+    (test (string-ci>? "A" "z") #f)
+    (test (string-ci>? "Z" "a") #t)
+    (test (string-ci>? "z" "A") #t)
+    (test (string-ci>? "z" "Z") #f)
+    (test (string-ci>? "Z" "z") #f)
     (test (string-ci=? "z" "Z") #t)
+    (test (string-ci=? "z" "a") #f)
     (test (string-ci=? "Stra\xDF;e" "Strasse") #t)
     (test (string-ci=? "Stra\xDF;e" "STRASSE") #t)
     (test (string-ci=? "\x39E;\x391;\x39F;\x3A3;" "\x3BE;\x3B1;\x3BF;\x3C2;") #t)
     (test (string-ci=? "\x39E;\x391;\x39F;\x3A3;" "\x3BE;\x3B1;\x3BF;\x3C3;") #t)
+    (test (string-ci<=? "a" "Z") #t)
+    (test (string-ci<=? "A" "z") #t)
+    (test (string-ci<=? "Z" "a") #f)
+    (test (string-ci<=? "z" "A") #f)
+    (test (string-ci<=? "z" "Z") #t)
+    (test (string-ci<=? "Z" "z") #t)
+    (test (string-ci>=? "a" "Z") #f)
+    (test (string-ci>=? "A" "z") #f)
+    (test (string-ci>=? "Z" "a") #t)
+    (test (string-ci>=? "z" "A") #t)
+    (test (string-ci>=? "z" "Z") #t)
+    (test (string-ci>=? "Z" "z") #t)
 
     (test (string-normalize-nfd "\xE9;") "\x65;\x301;")
     (test (string-normalize-nfc "\xE9;") "\xE9;")
     (test (string-normalize-nfd "\x65;\x301;") "\x65;\x301;")
     (test (string-normalize-nfc "\x65;\x301;") "\xE9;")
 
+    (test (string-normalize-nfkd "\xE9;") "\x65;\x301;")
+    (test (string-normalize-nfkc "\xE9;") "\xE9;")
+    (test (string-normalize-nfkd "\x65;\x301;") "\x65;\x301;")
+    (test (string-normalize-nfkc "\x65;\x301;") "\xE9;")
+
     ;;
     ))