;;;; 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.
;;;; 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.
;;;; This software is in the public domain and is provided with
;;;; absolutely no warranty. See the COPYING and CREDITS files for
;;;; more information.
;;; GET-DISPATCH-MACRO misbehavior fixed in sbcl-0.7.2.10, but
;;; was fixed a little later.)
(dolist (customizable-char
;;; 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)
;; So they should have no macro-characterness.
(multiple-value-bind (macro-fun non-terminating-p)
(get-macro-character customizable-char)
;;; 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)
;;; 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)
(assert-parse-error (parse-integer " "))
(assert-parse-error (parse-integer "12 a"))
(assert-parse-error (parse-integer "12a"))
(assert-parse-error (parse-integer " "))
(assert-parse-error (parse-integer "12 a"))
(assert-parse-error (parse-integer "12a"))
;;; #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()"))
;;; #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()"))
- "-.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"))
- 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
(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
(let ((standard-chars " !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~
")
(standard-terminating-macro-chars "\"'(),;`")
(standard-nonterminating-macro-chars "#"))
(flet ((frob (char)
(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)))))))
(let ((*readtable* (copy-readtable nil)))
(assert (null (loop for c across standard-chars append (frob c)))))))
- (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)))))))
(let ((*readtable* (copy-readtable nil)))
(assert (null (loop for c across standard-chars append (frob c)))))))
(multiple-value-bind (res err) (ignore-errors (read-from-string ""))
(assert (not res))
(assert (typep err 'end-of-file)))
(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))))