R6RS test suite contributions

svn: r11026

collects/tests/r6rs/README.txt

@@ -21,18 +21,30 @@ In general, for each `(rnrs <id> ... <id>)' in the standard:
  * There's a program "run/<id>/.../<id>.sps" that imports
    "<id>/.../<id>.sls", runs the tests, and reports the results.
 
-And then there's "run.sps", which runs all the tests (as noted
+And then there's 
-above). Also, "test.sls" implements `(tests r6rs test)', which
-implements the testing utilities that are used by all the other
-libraries.
 
-The "run-via-eval.sps" program is similar to "run.ss", but it
+ * "run.sps", which runs all the tests (as noted above)
-runs each set of tests via `eval'.
+
+ * "run-via-eval.sps", which is similar to "run.ss" but runs each set
+    of tests via `eval'
+
+ * "test.sls", containing `(tests r6rs test)', which implements the
+   testing utilities that are used by all the other libraries
+
+ * "contrib.sls" and "run/contrib.sps", which implement and run
+   contributed tests; these tests might be contributed when someone
+   finds a bug in an implementation that seems worth testing in other
+   implementations; also, they may be difficult to pin to a particular
+   R6RS library; finally, they may use extra libraries from the
+   "contrib" sub-directory
 
 ======================================================================
 Limitations and feedback
 ======================================================================
 
+The test suite tries to cover all of the bindings of R6RS, and it
+tries to check a variety of uses
+
 One goal of this test suite is to avoid using `eval' (except when
 specifcally testing `eval'). Avoiding `eval' makes the test suite as
 useful as possible to ahead-of-time compilers that implement `eval'

collects/tests/r6rs/base.sls

@@ -882,6 +882,20 @@
     (test/approx (imag-part 1.1+2.2i)              2.2)
     (test/approx (magnitude 1.1@2.2)              1.1)
 
+    (test (exact? (imag-part 0.0)) #t)
+    (test (exact? (imag-part 1.0)) #t)
+    (test (exact? (imag-part 1.1)) #t)
+    (test (exact? (imag-part +nan.0)) #t)
+    (test (exact? (imag-part +inf.0)) #t)
+    (test (exact? (imag-part -inf.0)) #t)
+
+    (test (zero? (imag-part 0.0)) #t)
+    (test (zero? (imag-part 1.0)) #t)
+    (test (zero? (imag-part 1.1)) #t)
+    (test (zero? (imag-part +nan.0)) #t)
+    (test (zero? (imag-part +inf.0)) #t)
+    (test (zero? (imag-part -inf.0)) #t) 
+
     (test/approx (angle 1.1@2.2)                  2.2)
 
     (test/approx (angle -1.0)         3.141592653589793)

collects/tests/r6rs/contrib.sls

@@ -0,0 +1,35 @@
+#!r6rs
+
+(library (tests r6rs contrib)
+  (export run-contrib-tests)
+  (import (rnrs)
+          (tests r6rs test)
+          (prefix (tests r6rs contrib helper1) L:))
+
+  ;; Definitions ----------------------------------------
+
+  ;; from Derick Eddington:
+  (define-syntax my-letrec
+    (syntax-rules ()
+      [(_ ([v e] ...) . b)
+       (let ()
+         (define t (list e ...))
+         (define v (let ([v (car t)]) (set! t (cdr t)) v))
+         ...
+         . b)]))
+
+  ;; Expressions ----------------------------------------
+
+  (define (run-contrib-tests)
+
+    ;; from Derick Eddington:
+    (test (my-letrec ([f (lambda (x) (g x 2))]
+                      [g (lambda (x y) (+ x y))])
+            (f 1))
+          3)
+
+    ;; from Derick Eddington:
+    (test (L:s L:x) 'ok)
+
+    ;;;
+    ))

collects/tests/r6rs/contrib/helper1.sls

@@ -0,0 +1,15 @@
+#!r6rs
+
+;; from Derick Eddington
+
+(library (tests r6rs contrib helper1)
+  (export x s)
+  (import (rnrs))
+  
+  (define-syntax x (lambda (_) #f))
+  
+  (define-syntax s
+    (syntax-rules (x)  ;; This x refers only to the one in scope above.
+      [(_ x)  ;; This pattern matches only if the 2nd subform is an
+              ;; identifier that is free-identifier=? to the x in the literals list.
+       'ok])))

collects/tests/r6rs/run-via-eval.sps

@@ -31,6 +31,7 @@
 (test-library run-mutable-pairs-tests      (tests r6rs mutable-pairs))
 (test-library run-mutable-strings-tests    (tests r6rs mutable-strings))
 (test-library run-r5rs-tests               (tests r6rs r5rs))
+(test-library run-contrib-tests            (tests r6rs contrib))
 
 (report-test-results)
 

collects/tests/r6rs/run.sps

@@ -25,7 +25,8 @@
         (tests r6rs eval)
         (tests r6rs mutable-pairs)
         (tests r6rs mutable-strings)
-        (tests r6rs r5rs))
+        (tests r6rs r5rs)
+        (tests r6rs contrib))
 
 (run-base-tests)
 
@@ -52,6 +53,7 @@
 (run-mutable-pairs-tests)
 (run-mutable-strings-tests)
 (run-r5rs-tests)
+(run-contrib-tests)
 
 (report-test-results)
 

collects/tests/r6rs/run/contrib.sps

@@ -0,0 +1,7 @@
+#!r6rs
+(import (tests r6rs contrib)
+        (tests r6rs test)
+        (rnrs io simple))
+(display "Running contibuted tests\n")
+(run-contrib-tests)
+(report-test-results)