cleaned up the test suite a little.

scheme/run-tests.ss

@@ -16,74 +16,31 @@
 ;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
 
-(import (ikarus)
+(import (ikarus))
-        (tests enums)
+              
-        (tests bitwise-op)
+(define test-libraries '(
-        (tests reader)
+  lists strings bytevectors hashtables fixnums bignums numerics
-        (tests lists)
+  bitwise enums pointers sorting io fasl reader case-folding
-        (tests bytevectors)
+  parse-flonums string-to-number bignum-to-flonum div-and-mod
-        (tests strings)
+  fldiv-and-mod))
-        (tests hashtables)
-        (tests numerics)
-        ;(tests numbers)
-        (tests bignums)
-        (tests fixnums)
-        (tests div-and-mod)
-        (tests fxcarry)
-        (tests bignum-to-flonum)
-        (tests string-to-number)
-        (tests input-ports)
-        (tests fldiv-and-mod)
-        (tests parse-flonums)
-        (tests io)
-        (tests case-folding)
-        (tests sorting)
-        (tests fasl)
-        (tests pointers)
-        )
 
-(define (test-exact-integer-sqrt)
+(define (run-test-from-library x)
-  (define (f i j inc)
+  (printf "[testing ~a] ..." x)
-    (when (< i j)
+  (eval '(run-tests) (environment `(tests ,x)))
-      (let-values ([(s r) (exact-integer-sqrt i)])
+  (printf " OK\n"))
-        (unless (and (= (+ (* s s) r) i)
+
-                     (< i (* (+ s 1) (+ s 1))))
+(apply
-          (error 'exact-integer-sqrt "wrong result" i))
+  (case-lambda
-        (f (+ i inc) j inc))))
+    [(script) (for-each run-test-from-library test-libraries)]
-  (f 0 10000 1)
+    [(script . test-name*)
-  (f 0 536870911 10000)
+     (let ([test-name* (map string->symbol test-name*)])
-  (f 0 536870911000 536870911)
+       (for-each 
-  (printf "[exact-integer-sqrt] Happy Happy Joy Joy\n"))
+         (lambda (x) 
+           (unless (memq x test-libraries) 
+             (error script "invalid test name" x)))
+         test-name*)
+       (for-each run-test-from-library test-name*))])
+  (command-line))
+     
 
-(test-bitwise-op)
-(test-parse-flonums)
-(test-case-folding)
-(test-reader)
-(test-char-syntax)
-(test-bytevectors)
-(test-strings)
-(test-exact-integer-sqrt)
-(test-bignum-to-flonum)
-(test-bignum->flonum)
-(test-string-to-number)
-(test-div-and-mod)
-(test-bignums)
-(test-bignum-length)
-(test-fxcarry)
-(test-lists)
-(test-hashtables)
-(test-input-ports)
-(test-bignum-conversion)
-(test-fldiv-and-mod)
-(test-fldiv0-and-mod0)
-(test-fxdiv-and-mod)
-(test-fxdiv0-and-mod0)
-(test-fxlength)
-(test-bitwise-bit-count)
-(test-io)
-(test-sorting)
-(test-fasl)
-(test-numerics)
-(test-enums)
-(test-pointers)
 (printf "Happy Happy Joy Joy\n")

scheme/tests/bignum-to-flonum.ss

@@ -1,7 +1,15 @@
 
 (library (tests bignum-to-flonum)
-  (export test-bignum-to-flonum test-bignum->flonum)
+  (export run-tests)
   (import (ikarus) (tests framework))
+
+
+  (define (run-tests)
+    (test-bignum-to-flonum)
+    (test-bignum->flonum))
+
+
+
   (define (t x s)
     (let ([fl (format "~a" (exact->inexact x))])
       (unless (string=? s fl)

scheme/tests/bignums.ss

@@ -1,8 +1,15 @@
 (library (tests bignums)
-  (export test-bignums test-bignum-conversion test-bitwise-bit-count 
+  (export run-tests)
-          test-bignum-length)
   (import (ikarus) (tests framework))
 
+
+  (define (run-tests)
+    (test-bignums)
+    (test-bignum-conversion)
+    (test-bitwise-bit-count)
+    (test-bignum-length))
+
+
   (define (test-bignum-conversion)
     (define (test x) 
       (define (test1 x prefix radix)

scheme/tests/bitwise.ss

@@ -1,5 +1,5 @@
-(library (tests bitwise-op)
+(library (tests bitwise)
-  (export test-bitwise-op)
+  (export run-tests)
   (import (ikarus) (tests framework))
 
 
@@ -78,7 +78,7 @@
     )
 
 
-  (define (test-bitwise-op)
+  (define (run-tests)
     (test-base-cases)
     (test-other-cases)))
 

scheme/tests/bytevectors.ss

@@ -1,6 +1,6 @@
 
 (library (tests bytevectors)
-  (export test-bytevectors)
+  (export run-tests)
   (import (ikarus) (tests framework))
 
   (define (not-bytevector? x) 
@@ -380,8 +380,11 @@
          (bytevector-u8-set! bv (- sz 1) 73)
          (collect)
          ($bytevector-u8-ref bv (- sz 1))))]
-
+    )
-    ))
+  
+  (define (run-tests)
+    (test-bytevectors))
+  )
 
 
 

scheme/tests/case-folding.ss

@@ -1,6 +1,6 @@
 
 (library (tests case-folding)
-  (export test-case-folding)
+  (export run-tests)
   (import (ikarus))
 
   (define case-fold-mapping
@@ -1027,7 +1027,7 @@
         (test-strings (string (car x)) (list->string (cdr x))))
       case-fold-mapping))
 
-  (define (test-case-folding)
+  (define (run-tests)
     (test-char-by-char)
     (test-strings 
        (list->string (map car case-fold-mapping))

scheme/tests/div-and-mod.ss

@@ -1,8 +1,12 @@
 
 (library (tests div-and-mod)
-  (export test-div-and-mod test-div0-and-mod0)
+  (export run-tests)
   (import (ikarus))
 
+  (define (run-tests)
+    (test-div-and-mod)
+    (test-div0-and-mod0))
+
   (define (test-div-and-mod)
     (define (test x1 x2)
       (let-values ([(d m) (div-and-mod x1 x2)])

scheme/tests/enums.ss

@@ -15,10 +15,10 @@
 
 
 (library (tests enums)
-  (export test-enums)
+  (export run-tests)
   (import (ikarus))
     
-  (define (test-enums)
+  (define (run-tests)
     (define (trace-equal? x y) (equal? x y))
     (assert 
       (trace-equal? 

scheme/tests/fasl.ss

@@ -1,6 +1,6 @@
 
 (library (tests fasl)
-  (export test-fasl)
+  (export run-tests)
   (import (ikarus) (tests framework))
 
   (define (test x)
@@ -27,7 +27,7 @@
         (assert (eq? x (cdr x))))))
 
 
-  (define (test-fasl) 
+  (define (run-tests) 
     (test 12)
     (test -12)
     (test (greatest-fixnum))

scheme/tests/fixnums.ss

@@ -1,9 +1,59 @@
 
 (library (tests fixnums)
-  (export test-fxdiv-and-mod test-fxdiv0-and-mod0
+  (export run-tests)
-          test-fxlength)
   (import (ikarus))
 
+
+  (define (run-tests)
+    (test-fxdiv-and-mod)
+    (test-fxdiv0-and-mod0)
+    (test-fxlength)
+    (test-fxcarry))
+
+
+  (define (test-fxcarry)
+    (define (fx*/carry-reference fx1 fx2 fx3)
+      (let* ([s (+ (* fx1 fx2) fx3)]
+             [s0 (mod0 s (expt 2 (fixnum-width)))]
+             [s1 (div0 s (expt 2 (fixnum-width)))])
+        (values s0 s1)))
+    (define (fx+/carry-reference fx1 fx2 fx3)
+      (let* ([s (+ (+ fx1 fx2) fx3)]
+             [s0 (mod0 s (expt 2 (fixnum-width)))]
+             [s1 (div0 s (expt 2 (fixnum-width)))])
+        (values s0 s1)))
+    (define (fx-/carry-reference fx1 fx2 fx3)
+      (let* ([s (- (- fx1 fx2) fx3)]
+             [s0 (mod0 s (expt 2 (fixnum-width)))]
+             [s1 (div0 s (expt 2 (fixnum-width)))])
+        (values s0 s1)))
+    (define (test name fxop/carry fxop/carry-reference fx1 fx2 fx3)
+      (let-values ([(s0 s1) (fxop/carry fx1 fx2 fx3)]
+                   [(s2 s3) (fxop/carry-reference fx1 fx2 fx3)])
+        (unless (fx= s0 s2) 
+          (error name "failed (value1) on ~s ~s ~s, got ~s, should be ~s" 
+            fx1 fx2 fx3 s0 s2))
+        (unless (fx= s1 s3) 
+          (error name "failed (value2) on ~s ~s ~s, got ~s, should be ~s" 
+            fx1 fx2 fx3 s1 s3))))
+    (define ls 
+      (list 0 1 2 -1 -2 38734 -3843 2484598 -348732487 (greatest-fixnum) (least-fixnum)))
+    (printf "[~s: test-fxcarry] " (expt (length ls) 3))
+    (for-each 
+      (lambda (fx1)
+        (for-each 
+          (lambda (fx2)
+            (for-each 
+              (lambda (fx3)
+                (test 'fx*/carry fx*/carry fx*/carry-reference fx1 fx2 fx3)
+                (test 'fx+/carry fx+/carry fx+/carry-reference fx1 fx2 fx3)
+                (test 'fx-/carry fx-/carry fx-/carry-reference fx1 fx2 fx3))
+              ls))
+          ls))
+      ls)
+    )
+
+
   (define (test-fxdiv-and-mod)
     (define (test x1 x2)
       (let-values ([(d m) (fxdiv-and-mod x1 x2)])

scheme/tests/fldiv-and-mod.ss

@@ -1,8 +1,12 @@
 
 (library (tests fldiv-and-mod)
-  (export test-fldiv-and-mod test-fldiv0-and-mod0)
+  (export run-tests)
   (import (ikarus))
 
+  (define (run-tests)
+    (test-fldiv-and-mod)
+    (test-fldiv0-and-mod0))
+
 
   (define (test-fldiv-and-mod)
     (define (test x1 x2 verify?)

scheme/tests/fxcarry.ss

@@ -1,61 +0,0 @@
-
-(library (tests fxcarry)
-  (export test-fxcarry)
-  (import (ikarus) (tests framework))
-
-
-(define (fx*/carry-reference fx1 fx2 fx3)
-  (let* ([s (+ (* fx1 fx2) fx3)]
-         [s0 (mod0 s (expt 2 (fixnum-width)))]
-         [s1 (div0 s (expt 2 (fixnum-width)))])
-    (values s0 s1)))
-
-(define (fx+/carry-reference fx1 fx2 fx3)
-  (let* ([s (+ (+ fx1 fx2) fx3)]
-         [s0 (mod0 s (expt 2 (fixnum-width)))]
-         [s1 (div0 s (expt 2 (fixnum-width)))])
-    (values s0 s1)))
-
-(define (fx-/carry-reference fx1 fx2 fx3)
-  (let* ([s (- (- fx1 fx2) fx3)]
-         [s0 (mod0 s (expt 2 (fixnum-width)))]
-         [s1 (div0 s (expt 2 (fixnum-width)))])
-    (values s0 s1)))
-
-(define (test name fxop/carry fxop/carry-reference fx1 fx2 fx3)
-  (let-values ([(s0 s1) (fxop/carry fx1 fx2 fx3)]
-               [(s2 s3) (fxop/carry-reference fx1 fx2 fx3)])
-    (unless (fx= s0 s2) 
-      (error name "failed (value1) on ~s ~s ~s, got ~s, should be ~s" 
-        fx1 fx2 fx3 s0 s2))
-    (unless (fx= s1 s3) 
-      (error name "failed (value2) on ~s ~s ~s, got ~s, should be ~s" 
-        fx1 fx2 fx3 s1 s3))))
-
-(define ls 
-  (list 0 1 2 -1 -2 38734 -3843 2484598 -348732487 (greatest-fixnum) (least-fixnum)))
-
-(define (test-fxcarry)
-  (printf "[~s: test-fxcarry] " (expt (length ls) 3))
-  (for-each 
-    (lambda (fx1)
-      (for-each 
-        (lambda (fx2)
-          (for-each 
-            (lambda (fx3)
-              (test 'fx*/carry fx*/carry fx*/carry-reference fx1 fx2 fx3)
-              (test 'fx+/carry fx+/carry fx+/carry-reference fx1 fx2 fx3)
-              (test 'fx-/carry fx-/carry fx-/carry-reference fx1 fx2 fx3))
-            ls))
-        ls))
-    ls)
-  (printf "Happy Happy Joy Joy\n"))
-
-)
-
-#!eof
-
-(define (t x)
-  (= (fxsra (fx+ x 1) 1) 
-     (quotient x 2)))
-

scheme/tests/hashtables.ss

@@ -1,10 +1,12 @@
 (library (tests hashtables)
-  (export test-hashtables)
+  (export run-tests)
   (import 
     (ikarus)
     (rnrs hashtables)
     (tests framework))
 
+  (define (run-tests) (test-hashtables))
+
   (define-tests test-hashtables
     [values
      (let ([h (make-eq-hashtable)])

scheme/tests/input-ports.ss

@@ -1,16 +0,0 @@
-
-(library (tests input-ports)
-  (export test-input-ports)
-  (import (ikarus) (tests framework))
-
-
-  (define-tests test-input-ports
-    [eof-object?
-     (get-line (open-string-input-port ""))]
-    [(lambda (x) (equal? x "abcd"))
-     (get-line (open-string-input-port "abcd"))]
-    [(lambda (x) (equal? x ""))
-     (get-line (open-string-input-port "\nabcd"))]
-    [(lambda (x) (equal? x "abcd"))
-     (get-line (open-string-input-port "abcd\nefg"))]))
-

scheme/tests/io.ss

@@ -1,7 +1,7 @@
 
 (library (tests io)
-  (export test-io)
+  (export run-tests)
-  (import (ikarus))
+  (import (ikarus)(tests framework))
 
 
 (define-syntax test
@@ -522,13 +522,21 @@
   ;(test 'utf16 (utf-16-codec) string->utf16)
   (test 'utf8 (utf-8-codec) string->utf8))
 
+  (define-tests test-input-ports
+    [eof-object?
+     (get-line (open-string-input-port ""))]
+    [(lambda (x) (equal? x "abcd"))
+     (get-line (open-string-input-port "abcd"))]
+    [(lambda (x) (equal? x ""))
+     (get-line (open-string-input-port "\nabcd"))]
+    [(lambda (x) (equal? x "abcd"))
+     (get-line (open-string-input-port "abcd\nefg"))])
 
-(define (test-io)
+(define (run-tests)
   (test-custom-binary-input-ports)
   (test-custom-binary-output-ports)
   (run-exhaustive-tests)
   (test-input-files)
-  (test-partial-reads))
+  (test-partial-reads)
+  (test-input-ports))
 )
-;(run-interactive-tests)
-

scheme/tests/lists.ss

@@ -1,7 +1,9 @@
 (library (tests lists)
-  (export test-lists)
+  (export run-tests)
   (import (ikarus) (tests framework))
 
+  (define (run-tests) (test-lists))
+
   (define-tests test-lists
     [values (equal? (for-all even? '(1 2 3 4)) #f)]
     [values (equal? (for-all even? '(10 12 14 16)) #t)]

scheme/tests/numerics.ss

@@ -1,22 +1,21 @@
 
 (library (tests numerics)
-  (export test-numerics)
+  (export run-tests)
   (import (ikarus))
 
-  (define (test-round x)
+  (define (test-rounding)
-    (let ([rx (round x)])
+    (define (test-round x)
-      (unless (integer? rx)
+      (let ([rx (round x)])
-        (error 'test-round "not an integer result for" x rx))
+        (unless (integer? rx)
-      (let ([diff (abs (- (abs x) (abs rx)))])
+          (error 'test-round "not an integer result for" x rx))
-        (cond
+        (let ([diff (abs (- (abs x) (abs rx)))])
-          [(= diff 1/2) 
+          (cond
-           (unless (even? rx)
+            [(= diff 1/2) 
-             (error 'test-round "non-even rounding for" x rx))]
+             (unless (even? rx)
-          [else
+               (error 'test-round "non-even rounding for" x rx))]
-           (unless (< diff 1/2)
+            [else
-             (error 'test-round "rounding the wrong way for" x rx))]))))
+             (unless (< diff 1/2)
-
+               (error 'test-round "rounding the wrong way for" x rx))]))))
-  (define (test-numerics)
     (test-round -251/100)
     (test-round -250/100)
     (test-round -249/100)
@@ -36,4 +35,36 @@
     (test-round -349/100)
     (test-round +351/100)
     (test-round +350/100)
-    (test-round +349/100)))
+    (test-round +349/100))
+
+  (define (test-eqv)
+    (define (test-eqv x y result)
+      (unless (eqv? (eqv? x y) result) 
+        (error 'test-eqv "failed" x y result)))
+    (test-eqv 0 0 #t)
+    (test-eqv 0.0 0 #f)
+    (test-eqv 0 0.0 #f)
+    (test-eqv 0.0 0.0 #t)
+    (test-eqv 0.0 -0.0 #f)
+    (test-eqv -0.0 0.0 #f)
+    (test-eqv -0.0 -0.0 #t))
+
+
+
+  (define (test-exact-integer-sqrt)
+    (define (f i j inc)
+      (when (< i j)
+        (let-values ([(s r) (exact-integer-sqrt i)])
+          (unless (and (= (+ (* s s) r) i)
+                       (< i (* (+ s 1) (+ s 1))))
+            (error 'exact-integer-sqrt "wrong result" i))
+          (f (+ i inc) j inc))))
+    (f 0 10000 1)
+    (f 0 536870911 10000)
+    (f 0 536870911000 536870911))
+
+
+  (define (run-tests)
+    (test-rounding)
+    (test-exact-integer-sqrt)
+    #;(test-eqv)))

scheme/tests/parse-flonums.ss

@@ -1,6 +1,6 @@
 
 (library (tests parse-flonums)
-  (export test-parse-flonums)
+  (export run-tests)
   (import (ikarus))
   
   (define file "tests/rn100")
@@ -83,7 +83,7 @@
                 (reverse ac)
                 (f (cons x ac))))))))
 
-  (define (test-parse-flonums)
+  (define (run-tests)
     (define who 'test-parse-flonums)
     (define failed #f)
     (define idx 0)

scheme/tests/pointers.ss

@@ -1,6 +1,6 @@
 
 (library (tests pointers)
-  (export test-pointers)
+  (export run-tests)
   (import (ikarus) (ikarus system $foreign))
 
   (define bits 
@@ -111,7 +111,7 @@
     (for-each check (u* n) (s* n)))
   
 
-  (define (test-pointers)
+  (define (run-tests)
     (for-each check-combinations '(8 16 32 64))
 
     (test-pointer-values)

scheme/tests/reader.ss

@@ -1,5 +1,5 @@
 (library (tests reader)
-  (export test-reader test-char-syntax)
+  (export run-tests)
   (import (ikarus) (tests framework))
 
   (define t
@@ -99,5 +99,11 @@
     [(lambda (x) (= (char->integer x) #x7F)) 
      (read (open-string-input-port "#\\delete"))])
 
+
+  (define (run-tests)
+    (test-char-syntax)
+    (test-reader))
+
+
   )
 

scheme/tests/sorting.ss

@@ -1,6 +1,6 @@
 
 (library (tests sorting)
-  (export test-sorting)
+  (export run-tests)
   (import (ikarus))
 
   (define (permutations ls)
@@ -99,7 +99,7 @@
     (test '(1 2 3 4 5 6 7))
     (test '(1 2 3 4 5 6 7 8)))
   
-  (define (test-sorting)
+  (define (run-tests)
     (test-permutations) 
     (test-vector-sort) 
     (test-list-sort)))

scheme/tests/string-to-number.ss

@@ -3,9 +3,12 @@
 ;;; assume reader which loads this file can only read signed integers.
 
 (library (tests string-to-number)
-  (export test-string-to-number)
+  (export run-tests)
   (import (ikarus) (tests framework))
 
+  (define (run-tests)
+    (test-string-to-number))
+
   (define (test string expected)
     (define (equal-results? x y)
       (define (== x y)

scheme/tests/strings.ss

@@ -1,7 +1,9 @@
 (library (tests strings)
-  (export test-strings)
+  (export run-tests)
   (import (ikarus) (tests framework))
 
+  (define (run-tests) (test-strings))
+
   (define-tests test-strings
     [values
      (string-ci=? "Strasse" "Stra\xDF;e")]