X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Freader.pure.lisp;h=567235d0d377ec07fbbc73bdc6d99d8ec196372f;hb=1cba0af01f5107ab384d0d8b94b1f6330b3d0ef4;hp=9a4307482015e7db5e991acea7fea1712f8e4817;hpb=cc676f35baa0a46df06d9917e087ca466d053027;p=sbcl.git

diff --git a/tests/reader.pure.lisp b/tests/reader.pure.lisp
index 9a43074..567235d 100644
--- a/tests/reader.pure.lisp
+++ b/tests/reader.pure.lisp
@@ -6,7 +6,7 @@
 ;;;; While most of SBCL is derived from the CMU CL system, the test
 ;;;; files (like this one) were written from scratch after the fork
 ;;;; from CMU CL.
-;;;; 
+;;;;
 ;;;; This software is in the public domain and is provided with
 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
 ;;;; more information.
@@ -38,9 +38,9 @@
 ;;; GET-DISPATCH-MACRO misbehavior fixed in sbcl-0.7.2.10, but
 ;;; was fixed a little later.)
 (dolist (customizable-char
-	 ;; According to ANSI "2.1.4 Character Syntax Types", these
-	 ;; characters are reserved for the programmer.
-	 '(#\? #\! #\[ #\] #\{ #\}))
+         ;; According to ANSI "2.1.4 Character Syntax Types", these
+         ;; characters are reserved for the programmer.
+         '(#\? #\! #\[ #\] #\{ #\}))
   ;; So they should have no macro-characterness.
   (multiple-value-bind (macro-fun non-terminating-p)
       (get-macro-character customizable-char)
@@ -51,3 +51,243 @@
     ;; so it'd be more logical for NON-TERMINATING-P to be T in
     ;; this case; but ANSI says it's NIL in this case.
     (assert (null non-terminating-p))))
+
+;;; rudimentary test of SET-SYNTAX-FROM-CHAR, just to verify that it
+;;; wasn't totally broken by the GET-MACRO-CHARACTER/SET-MACRO-CHARACTER
+;;; fixes in 0.7.3.16
+(assert (= 123579 (read-from-string "123579")))
+(let ((*readtable* (copy-readtable)))
+  (set-syntax-from-char #\7 #\;)
+  (assert (= 1235 (read-from-string "123579"))))
+
+;;; PARSE-INTEGER must signal an error of type PARSE-ERROR if it is
+;;; unable to parse an integer and :JUNK-ALLOWED is NIL.
+(macrolet ((assert-parse-error (form)
+             `(multiple-value-bind (val cond)
+                  (ignore-errors ,form)
+                (assert (null val))
+                (assert (typep cond 'parse-error)))))
+  (assert-parse-error (parse-integer "    "))
+  (assert-parse-error (parse-integer "12 a"))
+  (assert-parse-error (parse-integer "12a"))
+  (assert-parse-error (parse-integer "a"))
+  (assert (= (parse-integer "12") 12))
+  (assert (= (parse-integer "   12   ") 12))
+  (assert (= (parse-integer "   12asdb" :junk-allowed t) 12)))
+
+;;; #A notation enforces that once one 0 dimension has been found, all
+;;; subsequent ones are also 0.
+(assert (equal (array-dimensions (read-from-string "#3A()"))
+               '(0 0 0)))
+(assert (equal (array-dimensions (read-from-string "#3A(())"))
+               '(1 0 0)))
+(assert (equal (array-dimensions (read-from-string "#3A((() ()))"))
+               '(1 2 0)))
+
+;;; Bug reported by Nikodemus Siivola on sbcl-devel 2003-07-21:
+;;; package misconfiguration
+(assert (eq
+         (handler-case (with-input-from-string (s "cl:") (read s))
+           (end-of-file (c)
+             'good))
+         '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)))
+
+;;; parse-integer uses whitespace[1] not whitespace[2] as its
+;;; definition of whitespace to skip.
+(let ((*readtable* (copy-readtable)))
+  (set-syntax-from-char #\7 #\Space)
+  (assert (= 710 (parse-integer "710"))))
+
+(let ((*readtable* (copy-readtable)))
+  (set-syntax-from-char #\7 #\Space)
+  (assert (string= (format nil "~7D" 1) "      1")))
+
+(let ((symbol (find-symbol "DOES-NOT-EXIST" "CL-USER")))
+  (assert (null symbol))
+  (handler-case
+      (read-from-string "CL-USER:DOES-NOT-EXIST")
+    (reader-error (c)
+      (princ c))))
+
+;;; The GET-MACRO-CHARACTER in SBCL <= "1.0.34.2" bogusly computed its
+;;; second return value relative to *READTABLE* rather than the passed
+;;; readtable.
+(let* ((*readtable* (copy-readtable nil)))
+  (set-syntax-from-char #\" #\A)
+  (multiple-value-bind (reader-fn non-terminating-p)
+      (get-macro-character #\" (copy-readtable nil))
+    (declare (ignore reader-fn))
+    (assert (not non-terminating-p))))
+
+(with-test (:name :bug-309093)
+  (assert (eq :error
+              (handler-case
+                  (read-from-string "`#2A((,(1+ 0) 0) (0 0))")
+                (reader-error ()
+                  :error)))))
+
+(with-test (:name :set-syntax-from-char-dispatch-macro-char)
+  (let ((rt (copy-readtable)))
+    (make-dispatch-macro-character #\! nil rt)
+    (set-dispatch-macro-character #\! #\! (constantly 'bang^2) rt)
+    (flet ((maybe-bang ()
+             (let ((*readtable* rt))
+               (read-from-string "!!"))))
+      (assert (eq 'bang^2 (maybe-bang)))
+      (set-syntax-from-char #\! #\! rt)
+      (assert (eq '!! (maybe-bang))))))
+
+(with-test (:name :read-in-package-syntax)
+  (assert (equal '(sb-c::a (sb-kernel::x sb-kernel::y) sb-c::b)
+                 (read-from-string "sb-c::(a sb-kernel::(x y) b)")))
+  #+sb-package-locks
+  (assert (eq :violated!
+              (handler-case
+                  (read-from-string "cl::'foo")
+                (package-lock-violation ()
+                  :violated!)))))
+
+(with-test (:name :bug-309070)
+  (with-timeout 10
+    (assert (raises-error? (read-from-string "10e10000000000000000000")
+                           sb-kernel:reader-impossible-number-error))))
+
+(with-test (:name :bug-1095918)
+  (assert (= (length `#3(1)) 3)))