X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Freader.pure.lisp;h=62bd0002bdf58abe0532fe9c116e4e893069c563;hb=e1905b479292158bd2bacdebb81e27b4da041097;hp=7e964ff06d6094e1555a2820fac6c2ed0882013a;hpb=e8ba5a3c7e1b34b616391098b30b3c2ae8891d74;p=sbcl.git diff --git a/tests/reader.pure.lisp b/tests/reader.pure.lisp index 7e964ff..62bd000 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,86 +110,86 @@ (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" - "ee+9" "Ee+9" "eE+9" "EE+9" - "ee-9" "Ee-9" "eE-9" "EE-9" + #|"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" + "ee+9" "Ee+9" "eE+9" "EE+9" + "ee-9" "Ee-9" "eE-9" "EE-9" - "1e1e+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))))) + 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))))))) + (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))))))) @@ -197,14 +197,14 @@ ") (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 ((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))))))) @@ -224,3 +224,17 @@ (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")))