summaryrefslogtreecommitdiffstats
path: root/r4rstest.scm
diff options
context:
space:
mode:
authorBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:26 -0800
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:26 -0800
commitdeda2c0fd8689349fea2a900199a76ff7ecb319e (patch)
treec9726d54a0806a9b0c75e6c82db8692aea0053cf /r4rstest.scm
parent3278b75942bdbe706f7a0fba87729bb1e935b68b (diff)
downloadscm-deda2c0fd8689349fea2a900199a76ff7ecb319e.tar.gz
scm-deda2c0fd8689349fea2a900199a76ff7ecb319e.zip
Import Upstream version 5d6upstream/5d6
Diffstat (limited to 'r4rstest.scm')
-rw-r--r--r4rstest.scm99
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)