Import Upstream version 5c3upstream/5c3

1 files changed, 39 insertions, 29 deletions

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)