From 29edb9d800f6ebbc62970ea7830d9494c565cfcd Mon Sep 17 00:00:00 2001 From: Abdulaziz Ghuloum Date: Sat, 18 Oct 2008 13:03:17 -0400 Subject: [PATCH] cleaned up the test suite a little. --- scheme/run-tests.ss | 93 ++++++---------------- scheme/tests/bignum-to-flonum.ss | 10 ++- scheme/tests/bignums.ss | 11 ++- scheme/tests/{bitwise-op.ss => bitwise.ss} | 6 +- scheme/tests/bytevectors.ss | 9 ++- scheme/tests/case-folding.ss | 4 +- scheme/tests/div-and-mod.ss | 6 +- scheme/tests/enums.ss | 4 +- scheme/tests/fasl.ss | 4 +- scheme/tests/fixnums.ss | 54 ++++++++++++- scheme/tests/fldiv-and-mod.ss | 6 +- scheme/tests/fxcarry.ss | 61 -------------- scheme/tests/hashtables.ss | 4 +- scheme/tests/input-ports.ss | 16 ---- scheme/tests/io.ss | 20 +++-- scheme/tests/lists.ss | 4 +- scheme/tests/numerics.ss | 63 +++++++++++---- scheme/tests/parse-flonums.ss | 4 +- scheme/tests/pointers.ss | 4 +- scheme/tests/reader.ss | 8 +- scheme/tests/sorting.ss | 4 +- scheme/tests/string-to-number.ss | 5 +- scheme/tests/strings.ss | 4 +- 23 files changed, 207 insertions(+), 197 deletions(-) rename scheme/tests/{bitwise-op.ss => bitwise.ss} (96%) delete mode 100755 scheme/tests/fxcarry.ss delete mode 100644 scheme/tests/input-ports.ss diff --git a/scheme/run-tests.ss b/scheme/run-tests.ss index 370eb34..ac92f6c 100755 --- a/scheme/run-tests.ss +++ b/scheme/run-tests.ss @@ -16,74 +16,31 @@ ;;; along with this program. If not, see . -(import (ikarus) - (tests enums) - (tests bitwise-op) - (tests reader) - (tests lists) - (tests bytevectors) - (tests strings) - (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) - ) +(import (ikarus)) + +(define test-libraries '( + lists strings bytevectors hashtables fixnums bignums numerics + bitwise enums pointers sorting io fasl reader case-folding + parse-flonums string-to-number bignum-to-flonum div-and-mod + fldiv-and-mod)) -(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) - (printf "[exact-integer-sqrt] Happy Happy Joy Joy\n")) +(define (run-test-from-library x) + (printf "[testing ~a] ..." x) + (eval '(run-tests) (environment `(tests ,x))) + (printf " OK\n")) + +(apply + (case-lambda + [(script) (for-each run-test-from-library test-libraries)] + [(script . test-name*) + (let ([test-name* (map string->symbol test-name*)]) + (for-each + (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") diff --git a/scheme/tests/bignum-to-flonum.ss b/scheme/tests/bignum-to-flonum.ss index b3c7e2e..9dd258b 100644 --- a/scheme/tests/bignum-to-flonum.ss +++ b/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) diff --git a/scheme/tests/bignums.ss b/scheme/tests/bignums.ss index e53836a..e53dd2b 100644 --- a/scheme/tests/bignums.ss +++ b/scheme/tests/bignums.ss @@ -1,8 +1,15 @@ (library (tests bignums) - (export test-bignums test-bignum-conversion test-bitwise-bit-count - test-bignum-length) + (export run-tests) (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) diff --git a/scheme/tests/bitwise-op.ss b/scheme/tests/bitwise.ss similarity index 96% rename from scheme/tests/bitwise-op.ss rename to scheme/tests/bitwise.ss index 7344164..c6436bb 100644 --- a/scheme/tests/bitwise-op.ss +++ b/scheme/tests/bitwise.ss @@ -1,5 +1,5 @@ -(library (tests bitwise-op) - (export test-bitwise-op) +(library (tests bitwise) + (export run-tests) (import (ikarus) (tests framework)) @@ -78,7 +78,7 @@ ) - (define (test-bitwise-op) + (define (run-tests) (test-base-cases) (test-other-cases))) diff --git a/scheme/tests/bytevectors.ss b/scheme/tests/bytevectors.ss index d57bda4..6eec677 100644 --- a/scheme/tests/bytevectors.ss +++ b/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)) + ) diff --git a/scheme/tests/case-folding.ss b/scheme/tests/case-folding.ss index ac2a0aa..907fbb9 100644 --- a/scheme/tests/case-folding.ss +++ b/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)) diff --git a/scheme/tests/div-and-mod.ss b/scheme/tests/div-and-mod.ss index 720c878..33c481e 100644 --- a/scheme/tests/div-and-mod.ss +++ b/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)]) diff --git a/scheme/tests/enums.ss b/scheme/tests/enums.ss index fae785a..85c5393 100755 --- a/scheme/tests/enums.ss +++ b/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? diff --git a/scheme/tests/fasl.ss b/scheme/tests/fasl.ss index 1fbca78..960f724 100644 --- a/scheme/tests/fasl.ss +++ b/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)) diff --git a/scheme/tests/fixnums.ss b/scheme/tests/fixnums.ss index d432f67..245f743 100644 --- a/scheme/tests/fixnums.ss +++ b/scheme/tests/fixnums.ss @@ -1,9 +1,59 @@ (library (tests fixnums) - (export test-fxdiv-and-mod test-fxdiv0-and-mod0 - test-fxlength) + (export run-tests) (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)]) diff --git a/scheme/tests/fldiv-and-mod.ss b/scheme/tests/fldiv-and-mod.ss index c1eddda..113b6a1 100755 --- a/scheme/tests/fldiv-and-mod.ss +++ b/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?) diff --git a/scheme/tests/fxcarry.ss b/scheme/tests/fxcarry.ss deleted file mode 100755 index 889417c..0000000 --- a/scheme/tests/fxcarry.ss +++ /dev/null @@ -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))) - diff --git a/scheme/tests/hashtables.ss b/scheme/tests/hashtables.ss index 341b3b8..c9e4316 100644 --- a/scheme/tests/hashtables.ss +++ b/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)]) diff --git a/scheme/tests/input-ports.ss b/scheme/tests/input-ports.ss deleted file mode 100644 index f2c5b4e..0000000 --- a/scheme/tests/input-ports.ss +++ /dev/null @@ -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"))])) - diff --git a/scheme/tests/io.ss b/scheme/tests/io.ss index c7006ea..129b374 100755 --- a/scheme/tests/io.ss +++ b/scheme/tests/io.ss @@ -1,7 +1,7 @@ (library (tests io) - (export test-io) - (import (ikarus)) + (export run-tests) + (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) - diff --git a/scheme/tests/lists.ss b/scheme/tests/lists.ss index e65a1eb..a2b2a2f 100644 --- a/scheme/tests/lists.ss +++ b/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)] diff --git a/scheme/tests/numerics.ss b/scheme/tests/numerics.ss index bd33426..d62ae42 100644 --- a/scheme/tests/numerics.ss +++ b/scheme/tests/numerics.ss @@ -1,22 +1,21 @@ (library (tests numerics) - (export test-numerics) + (export run-tests) (import (ikarus)) - (define (test-round x) - (let ([rx (round x)]) - (unless (integer? rx) - (error 'test-round "not an integer result for" x rx)) - (let ([diff (abs (- (abs x) (abs rx)))]) - (cond - [(= diff 1/2) - (unless (even? rx) - (error 'test-round "non-even rounding for" x rx))] - [else - (unless (< diff 1/2) - (error 'test-round "rounding the wrong way for" x rx))])))) - - (define (test-numerics) + (define (test-rounding) + (define (test-round x) + (let ([rx (round x)]) + (unless (integer? rx) + (error 'test-round "not an integer result for" x rx)) + (let ([diff (abs (- (abs x) (abs rx)))]) + (cond + [(= diff 1/2) + (unless (even? rx) + (error 'test-round "non-even rounding for" x rx))] + [else + (unless (< diff 1/2) + (error 'test-round "rounding the wrong way for" x rx))])))) (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))) diff --git a/scheme/tests/parse-flonums.ss b/scheme/tests/parse-flonums.ss index 505802e..25baed9 100644 --- a/scheme/tests/parse-flonums.ss +++ b/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) diff --git a/scheme/tests/pointers.ss b/scheme/tests/pointers.ss index d3d2ef1..622accf 100644 --- a/scheme/tests/pointers.ss +++ b/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) diff --git a/scheme/tests/reader.ss b/scheme/tests/reader.ss index 6f76565..f11f6ba 100644 --- a/scheme/tests/reader.ss +++ b/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)) + + ) diff --git a/scheme/tests/sorting.ss b/scheme/tests/sorting.ss index b6afc09..79811c8 100755 --- a/scheme/tests/sorting.ss +++ b/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))) diff --git a/scheme/tests/string-to-number.ss b/scheme/tests/string-to-number.ss index eadeca1..3e3b757 100644 --- a/scheme/tests/string-to-number.ss +++ b/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) diff --git a/scheme/tests/strings.ss b/scheme/tests/strings.ss index 8963ebe..6af7b31 100644 --- a/scheme/tests/strings.ss +++ b/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")]