X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Freader.pure.lisp;h=567235d0d377ec07fbbc73bdc6d99d8ec196372f;hb=1cba0af01f5107ab384d0d8b94b1f6330b3d0ef4;hp=3a5459188edd988c581dac5b6835f2826713d486;hpb=abecd31762c38b078077ebbfbadb51139dee6059;p=sbcl.git diff --git a/tests/reader.pure.lisp b/tests/reader.pure.lisp index 3a54591..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) @@ -63,10 +63,10 @@ ;;; 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))))) + `(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")) @@ -78,11 +78,11 @@ ;;; #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))) + '(0 0 0))) (assert (equal (array-dimensions (read-from-string "#3A(())")) - '(1 0 0))) + '(1 0 0))) (assert (equal (array-dimensions (read-from-string "#3A((() ()))")) - '(1 2 0))) + '(1 2 0))) ;;; Bug reported by Nikodemus Siivola on sbcl-devel 2003-07-21: ;;; package misconfiguration @@ -110,66 +110,184 @@ (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")) + "-.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))))) + 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))))) + 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" + "+.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" + "ee+9" "Ee+9" "eE+9" "EE+9" + "ee-9" "Ee-9" "eE-9" "EE-9" - "A.0" "A.0e10" "a.0" "a.0e10" + "A.0" "A.0e10" "a.0" "a.0e10" - "1e1e+9")) + "1e1e+9")) (loop for i from 2 to 36 - do (setq *read-base* i) - do (assert (typep (read-from-string symbol-string) 'symbol))))) + 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)))