From: Taylor R Campbell <campbell@mumble.net>
Date: Thu, 8 Nov 2018 15:44:43 +0000 (+0000)
Subject: Some trivial tests for read/write invariance.
X-Git-Tag: mit-scheme-pucked-10.1.2~16^2~116^2~9
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=296a7cdf850a760da80f2d0e0405652d428feccb;p=mit-scheme.git

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 48b06b353..9e2a50e00 100644
--- a/tests/runtime/test-readwrite.scm
+++ b/tests/runtime/test-readwrite.scm
@@ -28,6 +28,60 @@ USA.
 
 (declare (usual-integrations))
 
+(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