From 879f4fa041cfdefee655eb877f1a91f86a9c62b7 Mon Sep 17 00:00:00 2001
From: Bryan Newbold <bnewbold@robocracy.org>
Date: Fri, 3 Mar 2017 00:56:40 -0800
Subject: New upstream version 5f2

---
 r4rstest.scm | 51 ++++++++++++++++++++++++++++++++++++++++++---------
 1 file changed, 42 insertions(+), 9 deletions(-)
 mode change 100644 => 100755 r4rstest.scm

(limited to 'r4rstest.scm')

diff --git a/r4rstest.scm b/r4rstest.scm
old mode 100644
new mode 100755
index b10cbd4..ec8af05
--- a/r4rstest.scm
+++ b/r4rstest.scm
@@ -203,6 +203,12 @@
 	       (do ((x x (cdr x))
 		    (sum 0 (+ sum (car x))))
 		   ((null? x) sum))))
+(test 25 'do (let ((x '(1 3 5 7 9))
+                   (sum 0))
+	       (do ((x x (cdr x)))
+		   ((null? x))
+		 (set! sum (+ sum (car x))))
+	       sum))
 (test 1 'let (let foo () 1))
 (test '((6 1 3) (-5 -2)) 'let
       (let loop ((numbers '(3 -2 1 6 -5))
@@ -551,7 +557,12 @@
 (test 0 +)
 (test 4 * 4)
 (test 1 *)
-
+(test 1 / 1)
+(test -1 / -1)
+(test 2 / 6 3)
+(test -3 / 6 -2)
+(test -3 / -6 2)
+(test 3 / -6 -2)
 (test -1 - 3 4)
 (test -3 - 3)
 (test 7 abs -7)
@@ -649,9 +660,9 @@
   (test #t 'max (inexact? (max f3.9 4)))
   (test f4.0 max f3.9 4)
   (test f4.0 exact->inexact 4)
-  (test f4.0 exact->inexact 4.0)
+  (test f4.0 exact->inexact f4.0)
   (test 4 inexact->exact 4)
-  (test 4 inexact->exact 4.0)
+  (test 4 inexact->exact f4.0)
   (test (- f4.0) round (- f4.5))
   (test (- f4.0) round (- f3.5))
   (test (- f4.0) round (- f3.9))
@@ -744,10 +755,9 @@
 		 (ok? (testit xx)))
 	    (cond ((not ok?)
 		   (display "Number readback failure for ")
-		   (display `(+ ,x (* ,j ,eps)))
-		   (newline)
-		   (display xx)
-		   (newline)
+		   (display `(+ ,x (* ,j ,eps))) (newline)
+		   (display xx) (newline)
+		   (display (string->number (number->string xx))) (newline)
 		   (set! all-ok? #f))
 		  ;;   (else (display xx) (newline))
 		  )))))
@@ -762,6 +772,18 @@
 		"0.1" "0.01" "0.001" "1.0e-20" "1.0e-50" "1.0e-100")))
 	res))
 
+    (define (float-rw-range-test)
+      (define success #t)
+      (do ((cnt -323 (+ 1 cnt)))
+	  ((> cnt 308) success)
+	(let* ((estr (string-append "1.e" (number->string cnt)))
+	       (num (string->number estr))
+	       (str (number->string num)))
+	  (cond ((or (>= (string-length str) 10)
+		     (not (equal? (string->number str) num)))
+		 (set! success #f)
+		 (for-each write (list estr num str (string->number str))))))))
+
     (SECTION 6 5 6)
     (test #t 'float-print-test (float-print-test f0.0))
     (test #t 'mult-float-print-test (mult-float-print-test f1.0))
@@ -772,7 +794,8 @@
     (test #t 'mult-float-print-test (mult-float-print-test
 				     (string->number "3.1415926535897931")))
     (test #t 'mult-float-print-test (mult-float-print-test
-				     (string->number "2.7182818284590451")))))
+				     (string->number "2.7182818284590451")))
+    (test #t float-rw-range-test)))
 
 (define (test-bignum)
   (define tb
@@ -782,6 +805,7 @@
   (define b3-3 (string->number "33333333333333333333"))
   (define b3-2 (string->number "33333333333333333332"))
   (define b3-0 (string->number "33333333333333333330"))
+  (define b1-1 (string->number "11111111111111111111"))
   (define b2-0 (string->number "2177452800"))
   (newline)
   (display ";testing bignums; ")
@@ -817,6 +841,14 @@
   (test #t 'remainder (tb (string->number "281474976710655325431") 65535))
   (test #t 'remainder (tb (string->number "281474976710655325430") 65535))
 
+  (test b1-1 gcd b3-3 b1-1)
+  (test 1 gcd b3-2 b1-1)
+  (test 1 gcd b3-0 b1-1)
+  (test 3 gcd b3-3 b3-0)
+
+  (test b3-3 lcm b3-3 b1-1)
+  (test b3-3 lcm -3 b1-1)
+
   (let ((n (string->number
 	    "30414093201713378043612608166064768844377641568960512")))
     (and n (exact? n)
@@ -1101,10 +1133,11 @@
 (test '#() make-vector 0 'a)
 (SECTION 6 9)
 (test #t procedure? car)
-;(test #f procedure? 'car)
+(test #f procedure? 'car)
 (test #t procedure? (lambda (x) (* x x)))
 (test #f procedure? '(lambda (x) (* x x)))
 (test #t call-with-current-continuation procedure?)
+(test #t procedure? /)
 (test 7 apply + (list 3 4))
 (test 7 apply (lambda (a b) (+ a b)) (list 3 4))
 (test 17 apply + 10 (list 3 4))
-- 
cgit v1.2.3