diff options
Diffstat (limited to 'r4rstest.scm')
| -rw-r--r-- | r4rstest.scm | 99 |
1 files changed, 75 insertions, 24 deletions
diff --git a/r4rstest.scm b/r4rstest.scm index bc3f2f7..3683f0d 100644 --- a/r4rstest.scm +++ b/r4rstest.scm @@ -1,4 +1,4 @@ -;; Copyright (C) 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. +;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 2000 Free Software Foundation, Inc. ;; ;; This program is free software; you can redistribute it and/or modify it ;; under the terms of the GNU General Public License as published by the @@ -184,9 +184,11 @@ (test 34 'letrec x) (test 10 'letrec (letrec ((x 3)) (define x 10) x)) (test 34 'letrec x) +(define (s x) (if x (let () (set! s x) (set! x s)))) (SECTION 4 2 3) (define x 0) -(test 6 'begin (begin (set! x 5) (+ x 1))) +(test 6 'begin (begin (set! x (begin (begin 5))) + (begin ((begin +) (begin x) (begin (begin 1)))))) (SECTION 4 2 4) (test '#(0 1 2 3 4) 'do (do ((vec (make-vector 5)) (i 0 (+ i 1))) @@ -241,16 +243,31 @@ (define first car) (test 1 'define (first '(1 2))) (define old-+ +) -(define + (lambda (x y) (list y x))) -(test '(3 6) add3 6) +(begin (begin (begin) + (begin (begin (begin) (define + (lambda (x y) (list y x))) + (begin))) + (begin)) + (begin) + (begin (begin (begin) (test '(3 6) add3 6) + (begin)))) (set! + old-+) (test 9 add3 6) +(begin) +(begin (begin)) +(begin (begin (begin (begin)))) (SECTION 5 2 2) (test 45 'define - (let ((x 5)) - (define foo (lambda (y) (bar x y))) - (define bar (lambda (a b) (+ (* a b) a))) - (foo (+ x 3)))) + (let ((x 5)) + (begin (begin (begin) + (begin (begin (begin) (define foo (lambda (y) (bar x y))) + (begin))) + (begin)) + (begin) + (begin) + (begin (define bar (lambda (a b) (+ (* a b) a)))) + (begin)) + (begin) + (begin (foo (+ x 3))))) (define x 34) (define (foo) (define x 5) x) (test 5 foo) @@ -523,6 +540,8 @@ (test 1 remainder 13 -4) (test -1 modulo -13 -4) (test -1 remainder -13 -4) +(test 0 modulo 0 86400) +(test 0 modulo 0 -86400) (define (divtest n1 n2) (= n1 (+ (* n2 (quotient n1 n2)) (remainder n1 n2)))) @@ -551,7 +570,6 @@ (define f0.8 (string->number "0.8")) (define f1.0 (string->number "1.0")) (define wto write-test-obj) - (define dto display-test-obj) (define lto load-test-obj) (newline) (display ";testing inexact numbers; ") @@ -571,20 +589,21 @@ (test f4.0 round f4.5) (test 1 expt 0 0) (test 0 expt 0 1) + (test (atan 1) atan 1 1) (set! write-test-obj (list f.25 f-3.25));.25 inexact errors less likely. - (set! display-test-obj (list f.25 f-3.25));.3 often has such errors (~10^-13) (set! load-test-obj (list 'define 'foo (list 'quote write-test-obj))) (test #t call-with-output-file "tmp3" (lambda (test-file) (write-char #\; test-file) - (display write-test-obj test-file) + (display #\; test-file) + (display ";" test-file) + (write write-test-obj test-file) (newline test-file) (write load-test-obj test-file) (output-port? test-file))) (check-test-file "tmp3") (set! write-test-obj wto) - (set! display-test-obj dto) (set! load-test-obj lto) (let ((x (string->number "4195835.0")) (y (string->number "3145727.0"))) @@ -707,13 +726,29 @@ (test 0 modulo 2177452800 -86400) (test 0 modulo 2177452800 86400) (test 0 modulo -2177452800 -86400) + (test 0 modulo 0 -2177452800) (test #t 'remainder (tb 281474976710655325431 65535)) (test #t 'remainder (tb 281474976710655325430 65535)) + (SECTION 6 5 8) (test 281474976710655325431 string->number "281474976710655325431") (test "281474976710655325431" number->string 281474976710655325431) (report-errs)) +(define (test-numeric-predicates) + (let* ((big-ex (expt 2 90)) + (big-inex (exact->inexact big-ex))) + (newline) + (display ";testing bignum-inexact comparisons;") + (newline) + (SECTION 6 5 5) + (test #f = (+ big-ex 1) big-inex (- big-ex 1)) + (test #f = big-inex (+ big-ex 1) (- big-ex 1)) + (test #t < (- (inexact->exact big-inex) 1) + big-inex + (+ (inexact->exact big-inex) 1)))) + + (SECTION 6 5 9) (test "0" number->string 0) (test "100" number->string 100) @@ -734,6 +769,10 @@ (test #f string->number "3.3I") (test #f string->number "-") (test #f string->number "+") +(test #t 'string->number (or (not (string->number "80000000" 16)) + (positive? (string->number "80000000" 16)))) +(test #t 'string->number (or (not (string->number "-80000000" 16)) + (negative? (string->number "-80000000" 16)))) (SECTION 6 6) (test #t eqv? '#\ #\Space) @@ -980,6 +1019,9 @@ (test '(b e h) map cadr '((a b) (d e) (g h))) (test '(5 7 9) map + '(1 2 3) '(4 5 6)) +(test '(1 2 3) map + '(1 2 3)) +(test '(1 2 3) map * '(1 2 3)) +(test '(-1 -2 -3) map - '(1 2 3)) (test '#(0 1 4 9 16) 'for-each (let ((v (make-vector 5))) (for-each (lambda (i) (vector-set! v i (* i i))) @@ -1097,21 +1139,23 @@ (test #t eof-object? (read-char test-file)) (input-port? test-file)))) (test #\; read-char test-file) - (test display-test-obj read test-file) + (test #\; read-char test-file) + (test #\; read-char test-file) + (test write-test-obj read test-file) (test load-test-obj read test-file) (close-input-port test-file)) (SECTION 6 10 3) (define write-test-obj - '(#t #f #\a () 9739 -3 . #((test) "te \" \" st" "" test #() b c))) -(define display-test-obj - '(#t #f a () 9739 -3 . #((test) te " " st test #() b c))) + '(#t #f a () 9739 -3 . #((test) "te \" \" st" "" test #() b c))) (define load-test-obj (list 'define 'foo (list 'quote write-test-obj))) (test #t call-with-output-file "tmp1" (lambda (test-file) (write-char #\; test-file) - (display write-test-obj test-file) + (display #\; test-file) + (display ";" test-file) + (write write-test-obj test-file) (newline test-file) (write load-test-obj test-file) (output-port? test-file))) @@ -1119,7 +1163,9 @@ (define test-file (open-output-file "tmp2")) (write-char #\; test-file) -(display write-test-obj test-file) +(display #\; test-file) +(display ";" test-file) +(write write-test-obj test-file) (newline test-file) (write load-test-obj test-file) (test #t output-port? test-file) @@ -1145,13 +1191,18 @@ (report-errs)) (report-errs) -(cond ((and (string->number "0.0") (inexact? (string->number "0.0"))) - (test-inexact) - (test-inexact-printing))) +(let ((have-inexacts? + (and (string->number "0.0") (inexact? (string->number "0.0")))) + (have-bignums? + (let ((n (string->number "281474976710655325431"))) + (and n (exact? n))))) + (cond (have-inexacts? + (test-inexact) + (test-inexact-printing))) + (if have-bignums? (test-bignum)) + (if (and have-inexacts? have-bignums?) + (test-numeric-predicates))) -(let ((n (string->number "281474976710655325431"))) - (if (and n (exact? n)) - (test-bignum))) (newline) (display "To fully test continuations, Scheme 4, and DELAY/FORCE do:") (newline) |