;; 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)))
projects / sbcl.git / blobdiff