From db04688faa20f3576257c0fe41752ec435beab9a Mon Sep 17 00:00:00 2001 From: Bryan Newbold Date: Mon, 20 Feb 2017 00:05:25 -0800 Subject: Import Upstream version 5c3 --- r4rstest.scm | 68 ++++++++++++++++++++++++++++++++++-------------------------- 1 file changed, 39 insertions(+), 29 deletions(-) (limited to 'r4rstest.scm') diff --git a/r4rstest.scm b/r4rstest.scm index 6573e20..35da2f4 100644 --- a/r4rstest.scm +++ b/r4rstest.scm @@ -13,7 +13,7 @@ ;; To receive a copy of the GNU General Public License, write to the ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA; or view -;; http://www-swiss.ai.mit.edu/~jaffer/GPL.html +;; http://swissnet.ai.mit.edu/~jaffer/GPL.html ;;;; "r4rstest.scm" Test correctness of scheme implementations. ;;; Author: Aubrey Jaffer @@ -105,10 +105,10 @@ (for-each (lambda (f) (set! i (+ 1 i)) (cond ((and (= i j)) - (cond ((not (f x))) (test #t f x))) + (cond ((not (f x)) (test #t f x)))) ((f x) (test #f f x))) (cond ((and (= i j)) - (cond ((not (f y))) (test #t f y))) + (cond ((not (f y)) (test #t f y)))) ((f y) (test #f f y)))) disjoint-type-functions)) (list #t #\a '() 9739 '(test) record-error "test" 'car '#(a b c)) @@ -259,6 +259,16 @@ (test 88 foo 88) (test 4 foo 4) (test 34 'define x) +(test 99 'internal-define (letrec ((foo (lambda (arg) + (or arg (and (procedure? foo) + (foo 99)))))) + (define bar (foo #f)) + (foo #f))) +(test 77 'internal-define (letrec ((foo 77) + (bar #f) + (retfoo (lambda () foo))) + (define baz (retfoo)) + (retfoo))) (SECTION 6 1) (test #f not #t) (test #f not 3) @@ -560,37 +570,37 @@ (display ";testing bignums; ") (newline) (SECTION 6 5 5) - (test 0 modulo 3333333333 3) - (test 0 modulo 3333333333 -3) - (test 0 remainder 3333333333 3) - (test 0 remainder 3333333333 -3) - (test 2 modulo 3333333332 3) - (test -1 modulo 3333333332 -3) - (test 2 remainder 3333333332 3) - (test 2 remainder 3333333332 -3) - (test 1 modulo -3333333332 3) - (test -2 modulo -3333333332 -3) - (test -2 remainder -3333333332 3) - (test -2 remainder -3333333332 -3) - - (test 3 modulo 3 3333333333) - (test 3333333330 modulo -3 3333333333) - (test 3 remainder 3 3333333333) - (test -3 remainder -3 3333333333) - (test -3333333330 modulo 3 -3333333333) - (test -3 modulo -3 -3333333333) - (test 3 remainder 3 -3333333333) - (test -3 remainder -3 -3333333333) + (test 0 modulo 33333333333333333333 3) + (test 0 modulo 33333333333333333333 -3) + (test 0 remainder 33333333333333333333 3) + (test 0 remainder 33333333333333333333 -3) + (test 2 modulo 33333333333333333332 3) + (test -1 modulo 33333333333333333332 -3) + (test 2 remainder 33333333333333333332 3) + (test 2 remainder 33333333333333333332 -3) + (test 1 modulo -33333333333333333332 3) + (test -2 modulo -33333333333333333332 -3) + (test -2 remainder -33333333333333333332 3) + (test -2 remainder -33333333333333333332 -3) + + (test 3 modulo 3 33333333333333333333) + (test 33333333333333333330 modulo -3 33333333333333333333) + (test 3 remainder 3 33333333333333333333) + (test -3 remainder -3 33333333333333333333) + (test -33333333333333333330 modulo 3 -33333333333333333333) + (test -3 modulo -3 -33333333333333333333) + (test 3 remainder 3 -33333333333333333333) + (test -3 remainder -3 -33333333333333333333) (test 0 modulo -2177452800 86400) (test 0 modulo 2177452800 -86400) (test 0 modulo 2177452800 86400) (test 0 modulo -2177452800 -86400) - (test #t 'remainder (tb 281474976710655 65535)) - (test #t 'remainder (tb 281474976710654 65535)) + (test #t 'remainder (tb 281474976710655325431 65535)) + (test #t 'remainder (tb 281474976710655325430 65535)) (SECTION 6 5 6) - (test 281474976710655 string->number "281474976710655") - (test "281474976710655" number->string 281474976710655) + (test 281474976710655325431 string->number "281474976710655325431") + (test "281474976710655325431" number->string 281474976710655325431) (report-errs)) (SECTION 6 5 6) @@ -1027,7 +1037,7 @@ (if (and (string->number "0.0") (inexact? (string->number "0.0"))) (test-inexact)) -(let ((n (string->number "281474976710655"))) +(let ((n (string->number "281474976710655325431"))) (if (and n (exact? n)) (test-bignum))) (newline) -- cgit v1.2.3