aboutsummaryrefslogtreecommitdiffstats
path: root/r4rstest.scm
diff options
context:
space:
mode:
authorLaMont Jones <lamont@debian.org>2003-05-07 08:36:40 -0600
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:27 -0800
commite21d47d7813159bb71e0671df9b52ec0470c358d (patch)
tree3c7770ea846123c291f599044e9f234ac17616bb /r4rstest.scm
parent8cfce36c6a4fc2e0a0ab6ef2db66a23cbe462693 (diff)
parentdeda2c0fd8689349fea2a900199a76ff7ecb319e (diff)
downloadscm-e21d47d7813159bb71e0671df9b52ec0470c358d.tar.gz
scm-e21d47d7813159bb71e0671df9b52ec0470c358d.zip
Import Debian changes 5d6-3.2debian/5d6-3.2
scm (5d6-3.2) unstable; urgency=low * Fix hppa compile. Closes: #144062 scm (5d6-3.1) unstable; urgency=low * NMU with patch from James Troup, to fix FTBFS on sparc. Closes: #191171 scm (5d6-3) unstable; urgency=low * Add build depend on xlibs-dev (Closes: #148020) scm (5d6-2) unstable; urgency=low * Remove libregexx-dev from build-depends. * Change build to use ./scmlit rather than scmlit (should fix some build problems) (looks like alpha is mostly building) * New release (Closes: #140175) * Built with turtlegraphics last time (Closes: #58515) scm (5d6-1) unstable; urgency=low * New upstream. * Add xlib and turtlegr to requested list of features. (closes some bug) * Make clean actually clean most everything up. * Remove hacks renaming build to something else and just set build as a .PHONY target in debian/rules. * Add the turtlegr code. scm (5d5-1) unstable; urgency=low * New upstream * Has fixes for 64 bit archs. May fix alpha compile problem. Does fix (Closes: #140175) * Take out -O2 arg. scm (5d4-3) unstable; urgency=low * Don't link with regexx, but just use libc6's regular expression functions. * Define (terms) to output /usr/share/common-licenses/GPL (Closes: #119321) scm (5d4-2) unstable; urgency=low * Add texinfo to build depends (Closes: #107011) scm (5d4-1) unstable; urgency=low * New upstream release. * Move install-info --remove to prerm. scm (5d3-5) unstable; urgency=low * Move scm info files to section "The Algorithmic Language Scheme" to match up with guile. scm (5d3-4) unstable; urgency=low * Fix build depends (Closes: #76691) scm (5d3-3) unstable; urgency=low * Fix path in scm dhelp file. scm (5d3-2) unstable; urgency=low * Actually put the header files in the package. Oops. scm (5d3-1) unstable; urgency=low * New upstream. (Closes: #74761) * Make (terms) use new license location. * Make use libregexx rather than librx. * Fix build depends for above. * Using new regex lib seems to fix crash (Closes: #66787) * Consider adding scm-dev package with headers, but instead just add the headers to the scm package. (Closes: #70787) * Add doc-base support.
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)