diff options
Diffstat (limited to 'r4rstest.scm')
| -rwxr-xr-x[-rw-r--r--] | r4rstest.scm | 51 |
1 files changed, 42 insertions, 9 deletions
diff --git a/r4rstest.scm b/r4rstest.scm index b10cbd4..ec8af05 100644..100755 --- a/r4rstest.scm +++ b/r4rstest.scm @@ -203,6 +203,12 @@ (do ((x x (cdr x)) (sum 0 (+ sum (car x)))) ((null? x) sum)))) +(test 25 'do (let ((x '(1 3 5 7 9)) + (sum 0)) + (do ((x x (cdr x))) + ((null? x)) + (set! sum (+ sum (car x)))) + sum)) (test 1 'let (let foo () 1)) (test '((6 1 3) (-5 -2)) 'let (let loop ((numbers '(3 -2 1 6 -5)) @@ -551,7 +557,12 @@ (test 0 +) (test 4 * 4) (test 1 *) - +(test 1 / 1) +(test -1 / -1) +(test 2 / 6 3) +(test -3 / 6 -2) +(test -3 / -6 2) +(test 3 / -6 -2) (test -1 - 3 4) (test -3 - 3) (test 7 abs -7) @@ -649,9 +660,9 @@ (test #t 'max (inexact? (max f3.9 4))) (test f4.0 max f3.9 4) (test f4.0 exact->inexact 4) - (test f4.0 exact->inexact 4.0) + (test f4.0 exact->inexact f4.0) (test 4 inexact->exact 4) - (test 4 inexact->exact 4.0) + (test 4 inexact->exact f4.0) (test (- f4.0) round (- f4.5)) (test (- f4.0) round (- f3.5)) (test (- f4.0) round (- f3.9)) @@ -744,10 +755,9 @@ (ok? (testit xx))) (cond ((not ok?) (display "Number readback failure for ") - (display `(+ ,x (* ,j ,eps))) - (newline) - (display xx) - (newline) + (display `(+ ,x (* ,j ,eps))) (newline) + (display xx) (newline) + (display (string->number (number->string xx))) (newline) (set! all-ok? #f)) ;; (else (display xx) (newline)) ))))) @@ -762,6 +772,18 @@ "0.1" "0.01" "0.001" "1.0e-20" "1.0e-50" "1.0e-100"))) res)) + (define (float-rw-range-test) + (define success #t) + (do ((cnt -323 (+ 1 cnt))) + ((> cnt 308) success) + (let* ((estr (string-append "1.e" (number->string cnt))) + (num (string->number estr)) + (str (number->string num))) + (cond ((or (>= (string-length str) 10) + (not (equal? (string->number str) num))) + (set! success #f) + (for-each write (list estr num str (string->number str)))))))) + (SECTION 6 5 6) (test #t 'float-print-test (float-print-test f0.0)) (test #t 'mult-float-print-test (mult-float-print-test f1.0)) @@ -772,7 +794,8 @@ (test #t 'mult-float-print-test (mult-float-print-test (string->number "3.1415926535897931"))) (test #t 'mult-float-print-test (mult-float-print-test - (string->number "2.7182818284590451"))))) + (string->number "2.7182818284590451"))) + (test #t float-rw-range-test))) (define (test-bignum) (define tb @@ -782,6 +805,7 @@ (define b3-3 (string->number "33333333333333333333")) (define b3-2 (string->number "33333333333333333332")) (define b3-0 (string->number "33333333333333333330")) + (define b1-1 (string->number "11111111111111111111")) (define b2-0 (string->number "2177452800")) (newline) (display ";testing bignums; ") @@ -817,6 +841,14 @@ (test #t 'remainder (tb (string->number "281474976710655325431") 65535)) (test #t 'remainder (tb (string->number "281474976710655325430") 65535)) + (test b1-1 gcd b3-3 b1-1) + (test 1 gcd b3-2 b1-1) + (test 1 gcd b3-0 b1-1) + (test 3 gcd b3-3 b3-0) + + (test b3-3 lcm b3-3 b1-1) + (test b3-3 lcm -3 b1-1) + (let ((n (string->number "30414093201713378043612608166064768844377641568960512"))) (and n (exact? n) @@ -1101,10 +1133,11 @@ (test '#() make-vector 0 'a) (SECTION 6 9) (test #t procedure? car) -;(test #f procedure? 'car) +(test #f procedure? 'car) (test #t procedure? (lambda (x) (* x x))) (test #f procedure? '(lambda (x) (* x x))) (test #t call-with-current-continuation procedure?) +(test #t procedure? /) (test 7 apply + (list 3 4)) (test 7 apply (lambda (a b) (+ a b)) (list 3 4)) (test 17 apply + 10 (list 3 4)) |