From eb88bee42b4f399cf9722a78f9c14a58c91ac0cb Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 1 Aug 2008 20:23:32 +0000 Subject: [PATCH] R6RS test suite contributions svn: r11026 --- collects/tests/r6rs/README.txt | 24 ++++++++++++----- collects/tests/r6rs/base.sls | 14 ++++++++++ collects/tests/r6rs/contrib.sls | 35 +++++++++++++++++++++++++ collects/tests/r6rs/contrib/helper1.sls | 15 +++++++++++ collects/tests/r6rs/run-via-eval.sps | 1 + collects/tests/r6rs/run.sps | 4 ++- collects/tests/r6rs/run/contrib.sps | 7 +++++ 7 files changed, 93 insertions(+), 7 deletions(-) create mode 100644 collects/tests/r6rs/contrib.sls create mode 100644 collects/tests/r6rs/contrib/helper1.sls create mode 100644 collects/tests/r6rs/run/contrib.sps diff --git a/collects/tests/r6rs/README.txt b/collects/tests/r6rs/README.txt index e29d5d7e66..bff52b93e1 100644 --- a/collects/tests/r6rs/README.txt +++ b/collects/tests/r6rs/README.txt @@ -21,18 +21,30 @@ In general, for each `(rnrs ... )' in the standard: * There's a program "run//.../.sps" that imports "/.../.sls", runs the tests, and reports the results. -And then there's "run.sps", which runs all the tests (as noted -above). Also, "test.sls" implements `(tests r6rs test)', which -implements the testing utilities that are used by all the other -libraries. +And then there's -The "run-via-eval.sps" program is similar to "run.ss", but it -runs each set of tests via `eval'. + * "run.sps", which runs all the tests (as noted above) + + * "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' diff --git a/collects/tests/r6rs/base.sls b/collects/tests/r6rs/base.sls index 006b3a5a6c..b437859c24 100644 --- a/collects/tests/r6rs/base.sls +++ b/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) diff --git a/collects/tests/r6rs/contrib.sls b/collects/tests/r6rs/contrib.sls new file mode 100644 index 0000000000..a85197c065 --- /dev/null +++ b/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) + + ;;; + )) diff --git a/collects/tests/r6rs/contrib/helper1.sls b/collects/tests/r6rs/contrib/helper1.sls new file mode 100644 index 0000000000..c8d349761a --- /dev/null +++ b/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]))) diff --git a/collects/tests/r6rs/run-via-eval.sps b/collects/tests/r6rs/run-via-eval.sps index 293048dc0f..e3dafb2a39 100644 --- a/collects/tests/r6rs/run-via-eval.sps +++ b/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) diff --git a/collects/tests/r6rs/run.sps b/collects/tests/r6rs/run.sps index 909df6954b..eee861a155 100644 --- a/collects/tests/r6rs/run.sps +++ b/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) diff --git a/collects/tests/r6rs/run/contrib.sps b/collects/tests/r6rs/run/contrib.sps new file mode 100644 index 0000000000..bb4b257064 --- /dev/null +++ b/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)