X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Freader.pure.lisp;h=0d229334289d1b8afc61cd1ad5e9a9de7c614ef7;hb=d8e682fdfb7e8ba067e15aea0f3d1f8d37ca9eb1;hp=f0644572ca0d82ec41f80ca48ace11f35e07912f;hpb=1f50b5779aeb575622b25721de552f404c77e150;p=sbcl.git

diff --git a/tests/reader.pure.lisp b/tests/reader.pure.lisp
index f064457..0d22933 100644
--- a/tests/reader.pure.lisp
+++ b/tests/reader.pure.lisp
@@ -90,4 +90,141 @@
          (handler-case (with-input-from-string (s "cl:") (read s))
            (end-of-file (c)
              'good))
-         'good))
\ No newline at end of file
+         'good))
+
+;;; Bugs found by Paul Dietz
+(assert (equal (multiple-value-list
+                (parse-integer "   123      "))
+               '(123 12)))
+
+(let* ((base "xxx 123  yyy")
+       (intermediate (make-array 8 :element-type (array-element-type base)
+                                 :displaced-to base
+                                 :displaced-index-offset 2))
+       (string (make-array 6 :element-type (array-element-type base)
+                           :displaced-to intermediate
+                           :displaced-index-offset 1)))
+  (assert (equal (multiple-value-list
+                  (parse-integer string))
+                 '(123 6))))
+
+(let ((*read-base* *read-base*))
+  (dolist (float-string '(".9" ".9e9" ".9e+9" ".9e-9"
+			  "-.9" "-.9e9" "-.9e+9" "-.9e-9"
+			  "+.9" "+.9e9" "+.9e+9" "+.9e-9"
+			  "0.9" "0.9e9" "0.9e+9" "0.9e-9"
+			  "9.09" "9.09e9" "9.09e+9" "9.09e-9"
+			  #|"9e9" could be integer|# "9e+9" "9e-9"))
+    (loop for i from 2 to 36
+	  do (setq *read-base* i)
+	  do (assert (typep (read-from-string float-string)
+			    *read-default-float-format*))
+	  do (assert (typep
+		      (read-from-string (substitute #\E #\e float-string))
+		      *read-default-float-format*))
+	  if (position #\e float-string)
+	  do (assert (typep
+		      (read-from-string (substitute #\s #\e float-string))
+		      'short-float))
+	  and do (assert (typep
+			  (read-from-string (substitute #\S #\e float-string))
+			  'short-float))
+	  and do (assert (typep
+			  (read-from-string (substitute #\f #\e float-string))
+			  'single-float))
+	  and do (assert (typep
+			  (read-from-string (substitute #\F #\e float-string))
+			  'single-float))
+	  and do (assert (typep
+			  (read-from-string (substitute #\d #\e float-string))
+			  'double-float))
+	  and do (assert (typep
+			  (read-from-string (substitute #\D #\e float-string))
+			  'double-float))
+	  and do (assert (typep
+			  (read-from-string (substitute #\l #\e float-string))
+			  'long-float))
+	  and do (assert (typep
+			  (read-from-string (substitute #\L #\e float-string))
+			  'long-float)))))
+
+(let ((*read-base* *read-base*))
+  (dolist (integer-string '("1." "2." "3." "4." "5." "6." "7." "8." "9." "0."))
+    (loop for i from 2 to 36
+	  do (setq *read-base* i)
+	  do (assert (typep (read-from-string integer-string) 'integer)))))
+
+(let ((*read-base* *read-base*))
+  (dolist (symbol-string '("A." "a." "Z." "z."
+			   
+			   "+.9eA" "+.9ea"
+			   
+			   "0.A" "0.a" "0.Z" "0.z"
+
+			   #|"9eA" "9ea"|# "9e+A" "9e+a" "9e-A" "9e-a"
+			   #|"Ae9" "ae9"|# "Ae+9" "ae+9" "Ae-9" "ae-9"
+
+			   "ee+9" "Ee+9" "eE+9" "EE+9"
+			   "ee-9" "Ee-9" "eE-9" "EE-9"
+
+			   "A.0" "A.0e10" "a.0" "a.0e10"
+
+			   "1e1e+9"))
+    (loop for i from 2 to 36
+	  do (setq *read-base* i)
+	  do (assert (typep (read-from-string symbol-string) 'symbol)))))
+
+(let ((standard-chars " !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~
+")
+      (standard-terminating-macro-chars "\"'(),;`")
+      (standard-nonterminating-macro-chars "#"))
+  (flet ((frob (char)
+	   (multiple-value-bind (fun non-terminating-p)
+	       (get-macro-character char)
+	     (cond
+	       ((find char standard-terminating-macro-chars)
+		(unless (and fun (not non-terminating-p))
+		  (list char)))
+	       ((find char standard-nonterminating-macro-chars)
+		(unless (and fun non-terminating-p)
+		  (list char)))
+	       (t (unless (and (not fun) (not non-terminating-p))
+		    (list char)))))))
+    (let ((*readtable* (copy-readtable nil)))
+      (assert (null (loop for c across standard-chars append (frob c)))))))
+
+(let ((standard-chars " !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~
+")
+      (undefined-chars "!\"$%&,;>?@[]^_`~{}/dDeEfFgGhHiIjJkKlLmMnNqQtTuUvVwWyYzZ"))
+  (flet ((frob (char)
+	   (let ((fun (get-dispatch-macro-character #\# char)))
+	     (cond
+	       ((find char undefined-chars)
+		(when fun (list char)))
+	       ((digit-char-p char 10)
+		(when fun (list char)))
+	       (t
+		(unless fun (list char)))))))
+    (let ((*readtable* (copy-readtable nil)))
+      (assert (null (loop for c across standard-chars append (frob c)))))))
+
+;;; All these must return a primary value of NIL when *read-suppress* is T
+;;; Reported by Bruno Haible on cmucl-imp 2004-10-25.
+(let ((*read-suppress* t))
+  (assert (null (read-from-string "(1 2 3)")))
+  (assert (null (with-input-from-string (s "abc xyz)")
+                  (read-delimited-list #\) s))))
+  (assert (null (with-input-from-string (s "(1 2 3)")
+                  (read-preserving-whitespace s))))
+  (assert (null (with-input-from-string (s "(1 2 3)")
+                 (read s)))))
+
+;;; EOF-ERROR-P defaults to true. Reported by Bruno Haible on
+;;; cmucl-imp 2004-10-18.
+(multiple-value-bind (res err) (ignore-errors (read-from-string ""))
+  (assert (not res))
+  (assert (typep err 'end-of-file)))
+
+(assert (equal '((0 . "A") (1 . "B"))
+               (coerce (read-from-string "#((0 . \"A\") (1 . \"B\"))") 
+                       'list)))