X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Freader.pure.lisp;h=0d229334289d1b8afc61cd1ad5e9a9de7c614ef7;hb=77d94d36bcfd3d5eea73ad51e6ee621a8938f995;hp=268d77e96ffd70265be46bc3c9dd0deca226a31c;hpb=56a972e201d117a8d5d769527f2bafd23cba7de9;p=sbcl.git diff --git a/tests/reader.pure.lisp b/tests/reader.pure.lisp index 268d77e..0d22933 100644 --- a/tests/reader.pure.lisp +++ b/tests/reader.pure.lisp @@ -114,7 +114,7 @@ "+.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" "9e+9" "9e-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) @@ -142,10 +142,10 @@ (read-from-string (substitute #\D #\e float-string)) 'double-float)) and do (assert (typep - (read-from-string (substitute #\d #\e float-string)) + (read-from-string (substitute #\l #\e float-string)) 'long-float)) and do (assert (typep - (read-from-string (substitute #\D #\e float-string)) + (read-from-string (substitute #\L #\e float-string)) 'long-float))))) (let ((*read-base* *read-base*)) @@ -161,10 +161,70 @@ "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" - - "A.0" "A.0e10" "a.0" "a.0e10")) + #|"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)))