tests/reader.pure.lisp

   1 ;;;; tests related to the Lisp reader
   2
   3 ;;;; This software is part of the SBCL system. See the README file for
   4 ;;;; more information.
   5 ;;;;
   6 ;;;; While most of SBCL is derived from the CMU CL system, the test
   7 ;;;; files (like this one) were written from scratch after the fork
   8 ;;;; from CMU CL.
   9 ;;;;
  10 ;;;; This software is in the public domain and is provided with
  11 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
  12 ;;;; more information.
  13
  14 (in-package "CL-USER")
  15
  16 (assert (equal (symbol-name '#:|fd\sA|) "fdsA"))
  17
  18 ;;; Prior to sbcl-0.7.2.10, SBCL disobeyed the ANSI requirements on
  19 ;;; returning NIL for unset dispatch-macro-character functions. (bug
  20 ;;; 151, fixed by Alexey Dejenka sbcl-devel "bug 151" 2002-04-12)
  21 (assert (not (get-dispatch-macro-character #\# #\{)))
  22 (assert (not (get-dispatch-macro-character #\# #\0)))
  23 ;;; And we might as well test that we don't have any cross-compilation
  24 ;;; shebang residues left...
  25 (assert (not (get-dispatch-macro-character #\# #\!)))
  26 ;;; Also test that all the illegal sharp macro characters are
  27 ;;; recognized as being illegal.
  28 (loop for char in '(#\Backspace #\Tab #\Newline #\Linefeed
  29                     #\Page #\Return #\Space #\) #\<)
  30    do (assert (get-dispatch-macro-character #\# char)))
  31
  32 (assert (not (ignore-errors (get-dispatch-macro-character #\! #\0)
  33                             t)))
  34
  35 ;;; In sbcl-0.7.3, GET-MACRO-CHARACTER and SET-MACRO-CHARACTER didn't
  36 ;;; use NIL to represent the no-macro-attached-to-this-character case
  37 ;;; as ANSI says they should. (This problem is parallel to the
  38 ;;; GET-DISPATCH-MACRO misbehavior fixed in sbcl-0.7.2.10, but
  39 ;;; was fixed a little later.)
  40 (dolist (customizable-char
  41          ;; According to ANSI "2.1.4 Character Syntax Types", these
  42          ;; characters are reserved for the programmer.
  43          '(#\? #\! #\[ #\] #\{ #\}))
  44   ;; So they should have no macro-characterness.
  45   (multiple-value-bind (macro-fun non-terminating-p)
  46       (get-macro-character customizable-char)
  47     (assert (null macro-fun))
  48     ;; Also, in a bit of ANSI weirdness, NON-TERMINATING-P can be
  49     ;; true only when MACRO-FUN is true. (When the character
  50     ;; is not a macro character, it can be embedded in a token,
  51     ;; so it'd be more logical for NON-TERMINATING-P to be T in
  52     ;; this case; but ANSI says it's NIL in this case.
  53     (assert (null non-terminating-p))))
  54
  55 ;;; rudimentary test of SET-SYNTAX-FROM-CHAR, just to verify that it
  56 ;;; wasn't totally broken by the GET-MACRO-CHARACTER/SET-MACRO-CHARACTER
  57 ;;; fixes in 0.7.3.16
  58 (assert (= 123579 (read-from-string "123579")))
  59 (let ((*readtable* (copy-readtable)))
  60   (set-syntax-from-char #\7 #\;)
  61   (assert (= 1235 (read-from-string "123579"))))
  62
  63 ;;; PARSE-INTEGER must signal an error of type PARSE-ERROR if it is
  64 ;;; unable to parse an integer and :JUNK-ALLOWED is NIL.
  65 (macrolet ((assert-parse-error (form)
  66              `(multiple-value-bind (val cond)
  67                   (ignore-errors ,form)
  68                 (assert (null val))
  69                 (assert (typep cond 'parse-error)))))
  70   (assert-parse-error (parse-integer "    "))
  71   (assert-parse-error (parse-integer "12 a"))
  72   (assert-parse-error (parse-integer "12a"))
  73   (assert-parse-error (parse-integer "a"))
  74   (assert (= (parse-integer "12") 12))
  75   (assert (= (parse-integer "   12   ") 12))
  76   (assert (= (parse-integer "   12asdb" :junk-allowed t) 12)))
  77
  78 ;;; #A notation enforces that once one 0 dimension has been found, all
  79 ;;; subsequent ones are also 0.
  80 (assert (equal (array-dimensions (read-from-string "#3A()"))
  81                '(0 0 0)))
  82 (assert (equal (array-dimensions (read-from-string "#3A(())"))
  83                '(1 0 0)))
  84 (assert (equal (array-dimensions (read-from-string "#3A((() ()))"))
  85                '(1 2 0)))
  86
  87 ;;; Bug reported by Nikodemus Siivola on sbcl-devel 2003-07-21:
  88 ;;; package misconfiguration
  89 (assert (eq
  90          (handler-case (with-input-from-string (s "cl:") (read s))
  91            (end-of-file (c)
  92              'good))
  93          'good))
  94
  95 ;;; Bugs found by Paul Dietz
  96 (assert (equal (multiple-value-list
  97                 (parse-integer "   123      "))
  98                '(123 12)))
  99
 100 (let* ((base "xxx 123  yyy")
 101        (intermediate (make-array 8 :element-type (array-element-type base)
 102                                  :displaced-to base
 103                                  :displaced-index-offset 2))
 104        (string (make-array 6 :element-type (array-element-type base)
 105                            :displaced-to intermediate
 106                            :displaced-index-offset 1)))
 107   (assert (equal (multiple-value-list
 108                   (parse-integer string))
 109                  '(123 6))))
 110
 111 (let ((*read-base* *read-base*))
 112   (dolist (float-string '(".9" ".9e9" ".9e+9" ".9e-9"
 113                           "-.9" "-.9e9" "-.9e+9" "-.9e-9"
 114                           "+.9" "+.9e9" "+.9e+9" "+.9e-9"
 115                           "0.9" "0.9e9" "0.9e+9" "0.9e-9"
 116                           "9.09" "9.09e9" "9.09e+9" "9.09e-9"
 117                           #|"9e9" could be integer|# "9e+9" "9e-9"))
 118     (loop for i from 2 to 36
 119           do (setq *read-base* i)
 120           do (assert (typep (read-from-string float-string)
 121                             *read-default-float-format*))
 122           do (assert (typep
 123                       (read-from-string (substitute #\E #\e float-string))
 124                       *read-default-float-format*))
 125           if (position #\e float-string)
 126           do (assert (typep
 127                       (read-from-string (substitute #\s #\e float-string))
 128                       'short-float))
 129           and do (assert (typep
 130                           (read-from-string (substitute #\S #\e float-string))
 131                           'short-float))
 132           and do (assert (typep
 133                           (read-from-string (substitute #\f #\e float-string))
 134                           'single-float))
 135           and do (assert (typep
 136                           (read-from-string (substitute #\F #\e float-string))
 137                           'single-float))
 138           and do (assert (typep
 139                           (read-from-string (substitute #\d #\e float-string))
 140                           'double-float))
 141           and do (assert (typep
 142                           (read-from-string (substitute #\D #\e float-string))
 143                           'double-float))
 144           and do (assert (typep
 145                           (read-from-string (substitute #\l #\e float-string))
 146                           'long-float))
 147           and do (assert (typep
 148                           (read-from-string (substitute #\L #\e float-string))
 149                           'long-float)))))
 150
 151 (let ((*read-base* *read-base*))
 152   (dolist (integer-string '("1." "2." "3." "4." "5." "6." "7." "8." "9." "0."))
 153     (loop for i from 2 to 36
 154           do (setq *read-base* i)
 155           do (assert (typep (read-from-string integer-string) 'integer)))))
 156
 157 (let ((*read-base* *read-base*))
 158   (dolist (symbol-string '("A." "a." "Z." "z."
 159
 160                            "+.9eA" "+.9ea"
 161
 162                            "0.A" "0.a" "0.Z" "0.z"
 163
 164                            #|"9eA" "9ea"|# "9e+A" "9e+a" "9e-A" "9e-a"
 165                            #|"Ae9" "ae9"|# "Ae+9" "ae+9" "Ae-9" "ae-9"
 166
 167                            "ee+9" "Ee+9" "eE+9" "EE+9"
 168                            "ee-9" "Ee-9" "eE-9" "EE-9"
 169
 170                            "A.0" "A.0e10" "a.0" "a.0e10"
 171
 172                            "1e1e+9"))
 173     (loop for i from 2 to 36
 174           do (setq *read-base* i)
 175           do (assert (typep (read-from-string symbol-string) 'symbol)))))
 176
 177 (let ((standard-chars " !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~
 178 ")
 179       (standard-terminating-macro-chars "\"'(),;`")
 180       (standard-nonterminating-macro-chars "#"))
 181   (flet ((frob (char)
 182            (multiple-value-bind (fun non-terminating-p)
 183                (get-macro-character char)
 184              (cond
 185                ((find char standard-terminating-macro-chars)
 186                 (unless (and fun (not non-terminating-p))
 187                   (list char)))
 188                ((find char standard-nonterminating-macro-chars)
 189                 (unless (and fun non-terminating-p)
 190                   (list char)))
 191                (t (unless (and (not fun) (not non-terminating-p))
 192                     (list char)))))))
 193     (let ((*readtable* (copy-readtable nil)))
 194       (assert (null (loop for c across standard-chars append (frob c)))))))
 195
 196 (let ((standard-chars " !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~
 197 ")
 198       (undefined-chars "!\"$%&,;>?@[]^_`~{}/dDeEfFgGhHiIjJkKlLmMnNqQtTuUvVwWyYzZ"))
 199   (flet ((frob (char)
 200            (let ((fun (get-dispatch-macro-character #\# char)))
 201              (cond
 202                ((find char undefined-chars)
 203                 (when fun (list char)))
 204                ((digit-char-p char 10)
 205                 (when fun (list char)))
 206                (t
 207                 (unless fun (list char)))))))
 208     (let ((*readtable* (copy-readtable nil)))
 209       (assert (null (loop for c across standard-chars append (frob c)))))))
 210
 211 ;;; All these must return a primary value of NIL when *read-suppress* is T
 212 ;;; Reported by Bruno Haible on cmucl-imp 2004-10-25.
 213 (let ((*read-suppress* t))
 214   (assert (null (read-from-string "(1 2 3)")))
 215   (assert (null (with-input-from-string (s "abc xyz)")
 216                   (read-delimited-list #\) s))))
 217   (assert (null (with-input-from-string (s "(1 2 3)")
 218                   (read-preserving-whitespace s))))
 219   (assert (null (with-input-from-string (s "(1 2 3)")
 220                  (read s)))))
 221
 222 ;;; EOF-ERROR-P defaults to true. Reported by Bruno Haible on
 223 ;;; cmucl-imp 2004-10-18.
 224 (multiple-value-bind (res err) (ignore-errors (read-from-string ""))
 225   (assert (not res))
 226   (assert (typep err 'end-of-file)))
 227
 228 (assert (equal '((0 . "A") (1 . "B"))
 229                (coerce (read-from-string "#((0 . \"A\") (1 . \"B\"))")
 230                        'list)))
 231
 232 ;;; parse-integer uses whitespace[1] not whitespace[2] as its
 233 ;;; definition of whitespace to skip.
 234 (let ((*readtable* (copy-readtable)))
 235   (set-syntax-from-char #\7 #\Space)
 236   (assert (= 710 (parse-integer "710"))))
 237
 238 (let ((*readtable* (copy-readtable)))
 239   (set-syntax-from-char #\7 #\Space)
 240   (assert (string= (format nil "~7D" 1) "      1")))
 241
 242 (let ((symbol (find-symbol "DOES-NOT-EXIST" "CL-USER")))
 243   (assert (null symbol))
 244   (handler-case
 245       (read-from-string "CL-USER:DOES-NOT-EXIST")
 246     (reader-error (c)
 247       (princ c))))
 248
 249 ;;; The GET-MACRO-CHARACTER in SBCL <= "1.0.34.2" bogusly computed its
 250 ;;; second return value relative to *READTABLE* rather than the passed
 251 ;;; readtable.
 252 (let* ((*readtable* (copy-readtable nil)))
 253   (set-syntax-from-char #\" #\A)
 254   (multiple-value-bind (reader-fn non-terminating-p)
 255       (get-macro-character #\" (copy-readtable nil))
 256     (declare (ignore reader-fn))
 257     (assert (not non-terminating-p))))
 258
 259 (with-test (:name :bug-309093)
 260   (assert (eq :error
 261               (handler-case
 262                   (read-from-string "`#2A((,(1+ 0) 0) (0 0))")
 263                 (reader-error ()
 264                   :error)))))
 265
 266 (with-test (:name set-syntax-from-char-dispatch-macro-char)
 267   (let ((rt (copy-readtable)))
 268     (make-dispatch-macro-character #\! nil rt)
 269     (set-dispatch-macro-character #\! #\! (constantly 'bang^2) rt)
 270     (flet ((maybe-bang ()
 271              (let ((*readtable* rt))
 272                (read-from-string "!!"))))
 273       (assert (eq 'bang^2 (maybe-bang)))
 274       (set-syntax-from-char #\! #\! rt)
 275       (assert (eq '!! (maybe-bang))))))