reader-test.lsp 9.16 KB
Newer Older
1 2 3 4 5 6 7
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Wed Apr  8 20:03:45 1998
;;;; Contains: Tests on readtables (just started, very incomplete)

(in-package :cl-test)

8

pfdietz's avatar
pfdietz committed
9 10 11

(def-syntax-test read-symbol.1
  (read-from-string "a")
12 13
  a 1)

pfdietz's avatar
pfdietz committed
14 15
(def-syntax-test read-symbol.2
  (read-from-string "|a|")
16 17
  |a| 3)

pfdietz's avatar
pfdietz committed
18
(def-syntax-test read-symbol.3
19
  (multiple-value-bind (s n)
pfdietz's avatar
pfdietz committed
20
      (read-from-string "#:abc")
21 22
    (not
     (and (symbolp s)
sds's avatar
sds committed
23 24 25
          (eql n 5)
          (not (symbol-package s))
          (string-equal (symbol-name s) "abc"))))
26
  nil)
27

pfdietz's avatar
pfdietz committed
28
(def-syntax-test read-symbol.4
29
  (multiple-value-bind (s n)
pfdietz's avatar
pfdietz committed
30
      (read-from-string "#:|abc|")
31 32
    (not
     (and (symbolp s)
sds's avatar
sds committed
33 34 35
          (eql n 7)
          (not (symbol-package s))
          (string= (symbol-name s) "abc"))))
36
  nil)
37

pfdietz's avatar
pfdietz committed
38
(def-syntax-test read-symbol.5
39
  (multiple-value-bind (s n)
pfdietz's avatar
pfdietz committed
40
      (read-from-string "#:||")
41
    (if (not (symbolp s))
sds's avatar
sds committed
42
        s
43
      (not (not
sds's avatar
sds committed
44 45 46
            (and (eql n 4)
                 (not (symbol-package s))
                 (string= (symbol-name s) ""))))))
47 48
  t)

pfdietz's avatar
pfdietz committed
49
(def-syntax-test read-symbol.6
50
  (let ((str "cl-test::abcd0123"))
51
    (multiple-value-bind (s n)
sds's avatar
sds committed
52
        (read-from-string str)
53
      (if (not (symbolp s))
sds's avatar
sds committed
54 55 56 57 58 59
          s
        (not (not
              (and (eql n (length str))
                   (eqt (symbol-package s) (find-package :cl-test))
                   (string-equal (symbol-name s)
                                 "abcd0123")))))))
60 61
  t)

pfdietz's avatar
pfdietz committed
62
(def-syntax-test read-symbol.7
63
  (multiple-value-bind (s n)
pfdietz's avatar
pfdietz committed
64
      (read-from-string ":ABCD")
65
    (if (not (symbolp s))
sds's avatar
sds committed
66
        s
67
      (not (not
sds's avatar
sds committed
68 69 70 71
            (and (eql n 5)
                 (eqt (symbol-package s) (find-package "KEYWORD"))
                 (string-equal (symbol-name s)
                               "ABCD"))))))
72
  t)
sds's avatar
sds committed
73

pfdietz's avatar
pfdietz committed
74 75 76 77 78
(defun read-symbol.9-body (natoms maxlen &optional (chars +standard-chars+))
  (loop
   repeat natoms
   count
   (let* ((len (random (1+ maxlen)))
sds's avatar
sds committed
79 80 81
          (actual-len 0)
          (s (make-string (+ 2 (* 2 len))))
          (s2 (make-string len)))
pfdietz's avatar
pfdietz committed
82
     (loop for j from 0 to (1- len) do
sds's avatar
sds committed
83 84 85 86 87 88 89
           (let ((c (random-from-seq chars)))
             (when (member c '(#\| #\\))
               (setf (elt s actual-len) #\\)
               (incf actual-len))
             (setf (elt s actual-len) c)
             (setf (elt s2 j) c)
             (incf actual-len)))
pfdietz's avatar
pfdietz committed
90 91
     (let ((actual-string (subseq s 0 actual-len)))
       (multiple-value-bind (sym nread)
sds's avatar
sds committed
92 93 94 95 96 97 98 99 100
           (read-from-string
            (concatenate 'string "#:|" actual-string "|"))
         (unless (and (symbolp sym)
                      (eql nread (+ 4 actual-len))
                      (string-equal s2 (symbol-name sym)))
           (let ((*print-readably* t))
             (format t "Symbol read failed: ~S (~S) read as ~S~%"
                     actual-string s2 sym))
           t))))))
pfdietz's avatar
pfdietz committed
101 102 103 104 105 106 107

(def-syntax-test read-symbol.9
  (read-symbol.9-body 1000 100)
  0)

(def-syntax-test read-symbol.9a
  (let ((chars (coerce (loop for i below (min 256 char-code-limit)
sds's avatar
sds committed
108 109 110
                             for c = (code-char i)
                             when c collect c)
                       'string)))
pfdietz's avatar
pfdietz committed
111
    (if (> (length chars) 0)
sds's avatar
sds committed
112
        (read-symbol.9-body 1000 100)
pfdietz's avatar
pfdietz committed
113
      0))
114 115
  0)

pfdietz's avatar
pfdietz committed
116 117
(def-syntax-test read-symbol.9b
  (let ((chars (coerce (loop for i below (min 65536 char-code-limit)
sds's avatar
sds committed
118 119 120
                             for c = (code-char i)
                             when c collect c)
                       'string)))
pfdietz's avatar
pfdietz committed
121
    (if (> (length chars) 0)
sds's avatar
sds committed
122
        (read-symbol.9-body 1000 100)
pfdietz's avatar
pfdietz committed
123 124 125 126 127
      0))
  0)

(def-syntax-test read-symbol.10
  (equalt (symbol-name
sds's avatar
sds committed
128 129 130 131 132 133
           (read-from-string
            (with-output-to-string (s)
                                   (write (make-symbol ":")
                                          :readably t
                                          :stream s))))
          ":")
134 135
  t)

pfdietz's avatar
pfdietz committed
136 137
(def-syntax-test read-symbol.11
  (loop for c across +standard-chars+
sds's avatar
sds committed
138 139 140 141 142 143
        for str = (make-array 2 :element-type 'character :initial-contents (list #\\ c))
        for sym = (read-from-string str)
        unless (and (symbolp sym)
                    (eql sym (find-symbol (string c)))
                    (equal (symbol-name sym) (string c)))
        collect (list c str sym))
pfdietz's avatar
pfdietz committed
144 145 146 147
  nil)

(def-syntax-test read-symbol.12
  (loop for c across +standard-chars+
sds's avatar
sds committed
148 149 150 151 152 153
        for str = (make-array 2 :element-type 'base-char :initial-contents (list #\\ c))
        for sym = (read-from-string str)
        unless (and (symbolp sym)
                    (eql sym (find-symbol (string c)))
                    (equal (symbol-name sym) (string c)))
        collect (list c str sym))
pfdietz's avatar
pfdietz committed
154 155 156 157
  nil)

(def-syntax-test read-symbol.13
  (loop for i below (min 65536 char-code-limit)
sds's avatar
sds committed
158 159 160 161 162 163 164 165
        for c = (code-char i)
        for str = (and c (make-array 2 :element-type 'character :initial-contents (list #\\ c)))
        for sym = (and c (read-from-string str))
        unless (or (not c)
                   (and (symbolp sym)
                        (eql sym (find-symbol (string c)))
                        (equal (symbol-name sym) (string c))))
        collect (list c str sym))
pfdietz's avatar
pfdietz committed
166 167 168 169
  nil)

(def-syntax-test read-symbol.14
  (loop for i = (random (min (ash 1 24) char-code-limit))
sds's avatar
sds committed
170 171 172 173 174 175 176 177 178
        for c = (code-char i)
        for str = (and c (make-array 2 :element-type 'character :initial-contents (list #\\ c)))
        for sym = (and c (read-from-string str))
        repeat 1000
        unless (or (not c)
                   (and (symbolp sym)
                        (eql sym (find-symbol (string c)))
                        (equal (symbol-name sym) (string c))))
        collect (list c str sym))
pfdietz's avatar
pfdietz committed
179 180 181 182
  nil)

(def-syntax-test read-symbol.15
  (loop for c across "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ!@$%^&*_-+={}[]<>?/~"
sds's avatar
sds committed
183 184 185 186
        for str = (string c)
        for sym = (read-from-string str)
        unless (eql sym (find-symbol (string (char-upcase c))))
        collect (list c str sym))
pfdietz's avatar
pfdietz committed
187 188 189 190 191 192
  nil)

(def-syntax-test read-symbol.16
  (let ((*readtable* (copy-readtable)))
    (setf (readtable-case *readtable*) :downcase)
    (loop for c across "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ!@$%^&*_-+={}[]<>?/~"
sds's avatar
sds committed
193 194 195 196
          for str = (string c)
          for sym = (read-from-string str)
          unless (eql sym (find-symbol (string (char-downcase c))))
          collect (list c str sym)))
pfdietz's avatar
pfdietz committed
197 198 199 200 201 202
  nil)

(def-syntax-test read-symbol.17
  (let ((*readtable* (copy-readtable)))
    (setf (readtable-case *readtable*) :preserve)
    (loop for c across "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ!@$%^&*_-+={}[]<>?/~"
sds's avatar
sds committed
203 204 205 206
          for str = (string c)
          for sym = (read-from-string str)
          unless (eql sym (find-symbol str))
          collect (list c str sym)))
pfdietz's avatar
pfdietz committed
207 208 209 210 211 212
  nil)

(def-syntax-test read-symbol.18
  (let ((*readtable* (copy-readtable)))
    (setf (readtable-case *readtable*) :invert)
    (loop for c across "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ!@$%^&*_-+={}[]<>?/~"
sds's avatar
sds committed
213 214 215 216 217 218 219
          for str = (string c)
          for sym = (read-from-string str)
          for c2 = (cond ((upper-case-p c) (char-downcase c))
                         ((lower-case-p c) (char-upcase c))
                         (t c))
          unless (eql sym (find-symbol (string c2)))
          collect (list c c2 str sym)))
pfdietz's avatar
pfdietz committed
220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239
  nil)

(def-syntax-test read-symbol.19
  (read-from-string "123||")
  |123| 5)

(def-syntax-test read-symbol.20
  (read-from-string "123\\4")
  |1234| 5)

(def-syntax-test read-symbol.21
  (read-from-string "\\:1234")
  |:1234| 6)

(def-syntax-test read-symbol.22
  (read-from-string "||")
  #.(intern "" (find-package "CL-TEST")) 2)

(def-syntax-test read-symbol.23
  (loop for c across +standard-chars+
sds's avatar
sds committed
240 241 242 243 244 245 246 247 248
        for s = (concatenate 'string (string c) ".")
        for sym = (intern (string-upcase s))
        when (alpha-char-p c)
        nconc
        (let ((sym2 (let ((*read-base* 36))
                      (read-from-string s))))
          (if (eq sym sym2)
              nil
            (list c s sym sym2))))
pfdietz's avatar
pfdietz committed
249 250 251 252
  nil)

(def-syntax-test read-symbol.24
  (loop for c1 = (random-from-seq +alpha-chars+)
sds's avatar
sds committed
253 254 255 256 257 258 259 260 261 262 263
        for c2 = (random-from-seq +alpha-chars+)
        for d1 = (loop repeat (random 4) collect (random-from-seq +digit-chars+))
        for d2 = (loop repeat (random 4) collect (random-from-seq +digit-chars+))
        for s = (concatenate 'string d1 (list c1 c2) d2)
        for sym = (intern (string-upcase s))
        repeat 1000
        nconc
        (let ((sym2 (read-from-string s)))
          (if (eq sym sym2)
              nil
            (list c1 c2 d1 d2 s sym sym2))))
pfdietz's avatar
pfdietz committed
264 265 266 267
  nil)

(def-syntax-test read-symbol.25
  (let ((potential-chars "01234567890123456789+-esdlf_^/")
sds's avatar
sds committed
268
        (*readtable* (copy-readtable)))
pfdietz's avatar
pfdietz committed
269 270
    (setf (readtable-case *readtable*) :preserve)
    (loop for d1 = (loop repeat (random 6)
sds's avatar
sds committed
271 272 273 274 275 276 277 278 279 280 281
                         collect (random-from-seq potential-chars))
          for c = (random-from-seq potential-chars)
          for d2 = (loop repeat (random 6)
                         collect (random-from-seq potential-chars))
          for s1 = (concatenate 'string d1 (list c) d2)
          for sym1 = (intern s1)
          for s2 = (concatenate 'string d1 (list #\\ c) d2)
          for sym2 = (read-from-string s2)
          repeat 1000
          unless (eql sym1 sym2)
          collect (list d1 c d2 s1 sym1 s2 sym2)))
pfdietz's avatar
pfdietz committed
282 283
  nil)

284 285 286
(deftest read-float.1
  (eqlt -0.0 (- 0.0))
  t)