Some trivial tests for read/write invariance.

One xfail: The `nan.0' notation reads as NaN, not as a symbol, and
`+nan.0' is not recognized.

diff --git a/tests/runtime/test-readwrite.scm b/tests/runtime/test-readwrite.scm
index 48b06b3530a9a305ad3dcabed6b09a6edbb2bc50..9e2a50e00829b7ebbd26f6c89d1510d8fc43348e 100644 (file)
--- a/tests/runtime/test-readwrite.scm
+++ b/tests/runtime/test-readwrite.scm
@@ -28,6 +28,60 @@ USA.
 
 (declare (usual-integrations))
 \f
+(define (define-enumerated-test name cases procedure)
+  (define-test name
+    (map (lambda (casen)
+          (lambda ()
+            (with-test-properties (lambda () (apply procedure casen))
+              'DESCRIPTION (write-to-string casen))))
+        cases)))
+
+(define (with-expected-failure xfail? body)
+  (case xfail?
+    ((xfail) (expect-failure body))
+    ((xerror) (assert-error body))
+    (else (body))))
+
+(define assert-nan
+  (predicate-assertion nan? "NaN"))
+
+(define assert-inf
+  (predicate-assertion infinite? "infinity"))
+
+(define (assert-inf- x)
+  (assert-inf x)
+  (assert-< x 0))
+
+(define (assert-inf+ x)
+  (assert-inf x)
+  (assert-< 0 x))
+
+(define assert-symbol
+  (predicate-assertion symbol? "symbol"))
+
+(define (read-from-string string)
+  (read (open-input-string string)))
+
 (define-test 'DOT-SYMBOL-GETS-BARS
   (lambda ()
     (assert-equal (write-to-string (string->symbol ".")) "|.|")))
+
+(define-enumerated-test 'read/write-invariance
+  `(("+inf.0" ,assert-inf+)
+    ("-inf.0" ,assert-inf-)
+    ("inf.0" ,assert-symbol)
+    ("nan.0" ,assert-symbol xfail))
+  (lambda (string #!optional assertion xfail?)
+    (with-expected-failure xfail?
+      (lambda ()
+       (let ((object (read-from-string string)))
+         (assertion object)
+         (assert-equal (write-to-string object) string))))))
+
+(define-enumerated-test 'read
+  `(("+nan.0" ,assert-nan xfail)
+    ("-nan.0" ,assert-nan xfail))
+  (lambda (string assertion #!optional xfail?)
+    (with-expected-failure xfail?
+      (lambda ()
+       (assertion (read-from-string string))))))
\ No newline at end of file