X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Freader.pure.lisp;h=33af266560df0ef9931fcdbd643768576fb69259;hb=4ed3f0d08c3a57a6762018d9622f253ab9d0f2b6;hp=46f4db242549af7ddd7bb50b9a945cc491c50650;hpb=2963d6858d147b23c33f38e051e61264b479c9fc;p=sbcl.git

diff --git a/tests/reader.pure.lisp b/tests/reader.pure.lisp
index 46f4db2..33af266 100644
--- a/tests/reader.pure.lisp
+++ b/tests/reader.pure.lisp
@@ -16,14 +16,14 @@
 (assert (equal (symbol-name '#:|fd\sA|) "fdsA"))
 
 ;;; Prior to sbcl-0.7.2.10, SBCL disobeyed the ANSI requirements on
-;;; returning NIL for unset dispatch-macro-character functions (bug
+;;; returning NIL for unset dispatch-macro-character functions. (bug
 ;;; 151, fixed by Alexey Dejenka sbcl-devel "bug 151" 2002-04-12)
 (assert (not (get-dispatch-macro-character #\# #\{)))
 (assert (not (get-dispatch-macro-character #\# #\0)))
-;;; and we might as well test that we don't have any cross-compilation
+;;; And we might as well test that we don't have any cross-compilation
 ;;; shebang residues left...
 (assert (not (get-dispatch-macro-character #\# #\!)))
-;;; also test that all the illegal sharp macro characters are
+;;; Also test that all the illegal sharp macro characters are
 ;;; recognized as being illegal.
 (loop for char in '(#\Backspace #\Tab #\Newline #\Linefeed
                     #\Page #\Return #\Space #\) #\<)
@@ -31,3 +31,79 @@
 
 (assert (not (ignore-errors (get-dispatch-macro-character #\! #\0)
                             t)))
+
+;;; In sbcl-0.7.3, GET-MACRO-CHARACTER and SET-MACRO-CHARACTER didn't
+;;; use NIL to represent the no-macro-attached-to-this-character case
+;;; as ANSI says they should. (This problem is parallel to the
+;;; 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.
+	 '(#\? #\! #\[ #\] #\{ #\}))
+  ;; So they should have no macro-characterness.
+  (multiple-value-bind (macro-fun non-terminating-p)
+      (get-macro-character customizable-char)
+    (assert (null macro-fun))
+    ;; Also, in a bit of ANSI weirdness, NON-TERMINATING-P can be
+    ;; true only when MACRO-FUN is true. (When the character
+    ;; is not a macro character, it can be embedded in a token,
+    ;; 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))))