5 |
|
|
6 |
(in-package :cl-test) |
(in-package :cl-test) |
7 |
|
|
8 |
(deftest read-symbol.1 |
(compile-and-load "reader-aux.lsp") |
9 |
(let ((*package* (find-package "CL-TEST"))) |
|
10 |
(ignore-errors (read-from-string "a"))) |
(def-syntax-test read-symbol.1 |
11 |
|
(read-from-string "a") |
12 |
a 1) |
a 1) |
13 |
|
|
14 |
(deftest read-symbol.2 |
(def-syntax-test read-symbol.2 |
15 |
(let ((*package* (find-package "CL-TEST"))) |
(read-from-string "|a|") |
|
(ignore-errors (read-from-string "|a|"))) |
|
16 |
|a| 3) |
|a| 3) |
17 |
|
|
18 |
(deftest read-symbol.3 |
(def-syntax-test read-symbol.3 |
19 |
(multiple-value-bind (s n) |
(multiple-value-bind (s n) |
20 |
(let () (ignore-errors (read-from-string "#:abc"))) |
(read-from-string "#:abc") |
21 |
(not |
(not |
22 |
(and (symbolp s) |
(and (symbolp s) |
23 |
(eql n 5) |
(eql n 5) |
25 |
(string-equal (symbol-name s) "abc")))) |
(string-equal (symbol-name s) "abc")))) |
26 |
nil) |
nil) |
27 |
|
|
28 |
(deftest read-symbol.4 |
(def-syntax-test read-symbol.4 |
29 |
(multiple-value-bind (s n) |
(multiple-value-bind (s n) |
30 |
(let () (ignore-errors (read-from-string "#:|abc|"))) |
(read-from-string "#:|abc|") |
31 |
(not |
(not |
32 |
(and (symbolp s) |
(and (symbolp s) |
33 |
(eql n 7) |
(eql n 7) |
35 |
(string= (symbol-name s) "abc")))) |
(string= (symbol-name s) "abc")))) |
36 |
nil) |
nil) |
37 |
|
|
38 |
(deftest read-symbol.5 |
(def-syntax-test read-symbol.5 |
39 |
(multiple-value-bind (s n) |
(multiple-value-bind (s n) |
40 |
(let () (ignore-errors (read-from-string "#:||"))) |
(read-from-string "#:||") |
41 |
(if (not (symbolp s)) |
(if (not (symbolp s)) |
42 |
s |
s |
43 |
(not (not |
(not (not |
46 |
(string= (symbol-name s) "")))))) |
(string= (symbol-name s) "")))))) |
47 |
t) |
t) |
48 |
|
|
49 |
(deftest read-symbol.6 |
(def-syntax-test read-symbol.6 |
50 |
(let ((str "cl-test::abcd0123")) |
(let ((str "cl-test::abcd0123")) |
51 |
(multiple-value-bind (s n) |
(multiple-value-bind (s n) |
52 |
(ignore-errors (read-from-string str)) |
(read-from-string str) |
53 |
(if (not (symbolp s)) |
(if (not (symbolp s)) |
54 |
s |
s |
55 |
(not (not |
(not (not |
59 |
"abcd0123"))))))) |
"abcd0123"))))))) |
60 |
t) |
t) |
61 |
|
|
62 |
(deftest read-symbol.7 |
(def-syntax-test read-symbol.7 |
63 |
(multiple-value-bind (s n) |
(multiple-value-bind (s n) |
64 |
(let () (ignore-errors (read-from-string ":ABCD"))) |
(read-from-string ":ABCD") |
65 |
(if (not (symbolp s)) |
(if (not (symbolp s)) |
66 |
s |
s |
67 |
(not (not |
(not (not |
71 |
"ABCD")))))) |
"ABCD")))))) |
72 |
t) |
t) |
73 |
|
|
74 |
(defun read-symbol.9-body (natoms maxlen) |
(defun read-symbol.9-body (natoms maxlen &optional (chars +standard-chars+)) |
75 |
(let* ((chars (concatenate 'string |
(loop |
76 |
"abcdefghijklmnopqrstuvwxyz" |
repeat natoms |
77 |
"ABCDEFGHIJKLMNOPQRSTUVWXYZ" |
count |
78 |
"0123456789" |
(let* ((len (random (1+ maxlen))) |
79 |
"<,>.?/\"':;[{]}~`!@#$%^&*()_-+= \\|")) |
(actual-len 0) |
80 |
(nchars (length chars))) |
(s (make-string (+ 2 (* 2 len)))) |
81 |
(loop |
(s2 (make-string len))) |
82 |
for i from 1 to natoms |
(loop for j from 0 to (1- len) do |
83 |
count |
(let ((c (random-from-seq chars))) |
84 |
(let* ((len (random (1+ maxlen))) |
(when (member c '(#\| #\\)) |
85 |
(actual-len 0) |
(setf (elt s actual-len) #\\) |
86 |
(s (make-string (+ 2 (* 2 len)))) |
(incf actual-len)) |
87 |
(s2 (make-string len))) |
(setf (elt s actual-len) c) |
88 |
(loop for j from 0 to (1- len) do |
(setf (elt s2 j) c) |
89 |
(let ((c (elt chars (random (max 1 (1- nchars)))))) |
(incf actual-len))) |
90 |
(when (member c '(#\| #\\)) |
(let ((actual-string (subseq s 0 actual-len))) |
91 |
(setf (elt s actual-len) #\\) |
(multiple-value-bind (sym nread) |
92 |
(incf actual-len)) |
(read-from-string |
93 |
(setf (elt s actual-len) c) |
(concatenate 'string "#:|" actual-string "|")) |
94 |
(setf (elt s2 j) c) |
(unless (and (symbolp sym) |
95 |
(incf actual-len))) |
(eql nread (+ 4 actual-len)) |
96 |
(let ((actual-string (subseq s 0 actual-len))) |
(string-equal s2 (symbol-name sym))) |
97 |
(multiple-value-bind (sym nread) |
(let ((*print-readably* t)) |
98 |
(ignore-errors (read-from-string |
(format t "Symbol read failed: ~S (~S) read as ~S~%" |
99 |
(concatenate 'string |
actual-string s2 sym)) |
100 |
"#:|" actual-string "|"))) |
t)))))) |
101 |
(unless (and (symbolp sym) |
|
102 |
(eql nread (+ 4 actual-len)) |
(def-syntax-test read-symbol.9 |
103 |
(string-equal s2 (symbol-name sym))) |
(read-symbol.9-body 1000 100) |
104 |
(let ((*print-readably* t)) |
0) |
|
(format t "Symbol read failed: ~S (~S) read as ~S~%" |
|
|
actual-string s2 sym)) |
|
|
t))))))) |
|
105 |
|
|
106 |
(deftest read-symbol.9 |
(def-syntax-test read-symbol.9a |
107 |
(read-symbol.9-body 1000 100) |
(let ((chars (coerce (loop for i below (min 256 char-code-limit) |
108 |
|
for c = (code-char i) |
109 |
|
when c collect c) |
110 |
|
'string))) |
111 |
|
(if (> (length chars) 0) |
112 |
|
(read-symbol.9-body 1000 100) |
113 |
|
0)) |
114 |
0) |
0) |
115 |
|
|
116 |
(deftest read-symbol.10 |
(def-syntax-test read-symbol.9b |
117 |
(handler-case |
(let ((chars (coerce (loop for i below (min 65536 char-code-limit) |
118 |
(not (not |
for c = (code-char i) |
119 |
(equal (symbol-name |
when c collect c) |
120 |
(read-from-string |
'string))) |
121 |
(with-output-to-string (s) |
(if (> (length chars) 0) |
122 |
(write (make-symbol ":") |
(read-symbol.9-body 1000 100) |
123 |
:readably t |
0)) |
124 |
:stream s)))) |
0) |
125 |
":"))) |
|
126 |
(error (c) c)) |
(def-syntax-test read-symbol.10 |
127 |
|
(equalt (symbol-name |
128 |
|
(read-from-string |
129 |
|
(with-output-to-string (s) |
130 |
|
(write (make-symbol ":") |
131 |
|
:readably t |
132 |
|
:stream s)))) |
133 |
|
":") |
134 |
t) |
t) |
135 |
|
|
136 |
|
(def-syntax-test read-symbol.11 |
137 |
|
(loop for c across +standard-chars+ |
138 |
|
for str = (make-array 2 :element-type 'character :initial-contents (list #\\ c)) |
139 |
|
for sym = (read-from-string str) |
140 |
|
unless (and (symbolp sym) |
141 |
|
(eql sym (find-symbol (string c))) |
142 |
|
(equal (symbol-name sym) (string c))) |
143 |
|
collect (list c str sym)) |
144 |
|
nil) |
145 |
|
|
146 |
|
(def-syntax-test read-symbol.12 |
147 |
|
(loop for c across +standard-chars+ |
148 |
|
for str = (make-array 2 :element-type 'base-char :initial-contents (list #\\ c)) |
149 |
|
for sym = (read-from-string str) |
150 |
|
unless (and (symbolp sym) |
151 |
|
(eql sym (find-symbol (string c))) |
152 |
|
(equal (symbol-name sym) (string c))) |
153 |
|
collect (list c str sym)) |
154 |
|
nil) |
155 |
|
|
156 |
|
(def-syntax-test read-symbol.13 |
157 |
|
(loop for i below (min 65536 char-code-limit) |
158 |
|
for c = (code-char i) |
159 |
|
for str = (and c (make-array 2 :element-type 'character :initial-contents (list #\\ c))) |
160 |
|
for sym = (and c (read-from-string str)) |
161 |
|
unless (or (not c) |
162 |
|
(and (symbolp sym) |
163 |
|
(eql sym (find-symbol (string c))) |
164 |
|
(equal (symbol-name sym) (string c)))) |
165 |
|
collect (list c str sym)) |
166 |
|
nil) |
167 |
|
|
168 |
|
(def-syntax-test read-symbol.14 |
169 |
|
(loop for i = (random (min (ash 1 24) char-code-limit)) |
170 |
|
for c = (code-char i) |
171 |
|
for str = (and c (make-array 2 :element-type 'character :initial-contents (list #\\ c))) |
172 |
|
for sym = (and c (read-from-string str)) |
173 |
|
repeat 1000 |
174 |
|
unless (or (not c) |
175 |
|
(and (symbolp sym) |
176 |
|
(eql sym (find-symbol (string c))) |
177 |
|
(equal (symbol-name sym) (string c)))) |
178 |
|
collect (list c str sym)) |
179 |
|
nil) |
180 |
|
|
181 |
|
(def-syntax-test read-symbol.15 |
182 |
|
(loop for c across "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ!@$%^&*_-+={}[]<>?/~" |
183 |
|
for str = (string c) |
184 |
|
for sym = (read-from-string str) |
185 |
|
unless (eql sym (find-symbol (string (char-upcase c)))) |
186 |
|
collect (list c str sym)) |
187 |
|
nil) |
188 |
|
|
189 |
|
(def-syntax-test read-symbol.16 |
190 |
|
(let ((*readtable* (copy-readtable))) |
191 |
|
(setf (readtable-case *readtable*) :downcase) |
192 |
|
(loop for c across "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ!@$%^&*_-+={}[]<>?/~" |
193 |
|
for str = (string c) |
194 |
|
for sym = (read-from-string str) |
195 |
|
unless (eql sym (find-symbol (string (char-downcase c)))) |
196 |
|
collect (list c str sym))) |
197 |
|
nil) |
198 |
|
|
199 |
|
(def-syntax-test read-symbol.17 |
200 |
|
(let ((*readtable* (copy-readtable))) |
201 |
|
(setf (readtable-case *readtable*) :preserve) |
202 |
|
(loop for c across "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ!@$%^&*_-+={}[]<>?/~" |
203 |
|
for str = (string c) |
204 |
|
for sym = (read-from-string str) |
205 |
|
unless (eql sym (find-symbol str)) |
206 |
|
collect (list c str sym))) |
207 |
|
nil) |
208 |
|
|
209 |
|
(def-syntax-test read-symbol.18 |
210 |
|
(let ((*readtable* (copy-readtable))) |
211 |
|
(setf (readtable-case *readtable*) :invert) |
212 |
|
(loop for c across "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ!@$%^&*_-+={}[]<>?/~" |
213 |
|
for str = (string c) |
214 |
|
for sym = (read-from-string str) |
215 |
|
for c2 = (cond ((upper-case-p c) (char-downcase c)) |
216 |
|
((lower-case-p c) (char-upcase c)) |
217 |
|
(t c)) |
218 |
|
unless (eql sym (find-symbol (string c2))) |
219 |
|
collect (list c c2 str sym))) |
220 |
|
nil) |
221 |
|
|
222 |
|
(def-syntax-test read-symbol.19 |
223 |
|
(read-from-string "123||") |
224 |
|
|123| 5) |
225 |
|
|
226 |
|
(def-syntax-test read-symbol.20 |
227 |
|
(read-from-string "123\\4") |
228 |
|
|1234| 5) |
229 |
|
|
230 |
|
(def-syntax-test read-symbol.21 |
231 |
|
(read-from-string "\\:1234") |
232 |
|
|:1234| 6) |
233 |
|
|
234 |
|
(def-syntax-test read-symbol.22 |
235 |
|
(read-from-string "||") |
236 |
|
#.(intern "" (find-package "CL-TEST")) 2) |
237 |
|
|
238 |
|
(def-syntax-test read-symbol.23 |
239 |
|
(loop for c across +standard-chars+ |
240 |
|
for s = (concatenate 'string (string c) ".") |
241 |
|
for sym = (intern (string-upcase s)) |
242 |
|
when (alpha-char-p c) |
243 |
|
nconc |
244 |
|
(let ((sym2 (let ((*read-base* 36)) |
245 |
|
(read-from-string s)))) |
246 |
|
(if (eq sym sym2) |
247 |
|
nil |
248 |
|
(list c s sym sym2)))) |
249 |
|
nil) |
250 |
|
|
251 |
|
(def-syntax-test read-symbol.24 |
252 |
|
(loop for c1 = (random-from-seq +alpha-chars+) |
253 |
|
for c2 = (random-from-seq +alpha-chars+) |
254 |
|
for d1 = (loop repeat (random 4) collect (random-from-seq +digit-chars+)) |
255 |
|
for d2 = (loop repeat (random 4) collect (random-from-seq +digit-chars+)) |
256 |
|
for s = (concatenate 'string d1 (list c1 c2) d2) |
257 |
|
for sym = (intern (string-upcase s)) |
258 |
|
repeat 1000 |
259 |
|
nconc |
260 |
|
(let ((sym2 (read-from-string s))) |
261 |
|
(if (eq sym sym2) |
262 |
|
nil |
263 |
|
(list c1 c2 d1 d2 s sym sym2)))) |
264 |
|
nil) |
265 |
|
|
266 |
|
(def-syntax-test read-symbol.25 |
267 |
|
(let ((potential-chars "01234567890123456789+-esdlf_^/") |
268 |
|
(*readtable* (copy-readtable))) |
269 |
|
(setf (readtable-case *readtable*) :preserve) |
270 |
|
(loop for d1 = (loop repeat (random 6) |
271 |
|
collect (random-from-seq potential-chars)) |
272 |
|
for c = (random-from-seq potential-chars) |
273 |
|
for d2 = (loop repeat (random 6) |
274 |
|
collect (random-from-seq potential-chars)) |
275 |
|
for s1 = (concatenate 'string d1 (list c) d2) |
276 |
|
for sym1 = (intern s1) |
277 |
|
for s2 = (concatenate 'string d1 (list #\\ c) d2) |
278 |
|
for sym2 = (read-from-string s2) |
279 |
|
repeat 1000 |
280 |
|
unless (eql sym1 sym2) |
281 |
|
collect (list d1 c d2 s1 sym1 s2 sym2))) |
282 |
|
nil) |
283 |
|
|
284 |
(deftest read-float.1 |
(deftest read-float.1 |
285 |
(eqlt -0.0 (- 0.0)) |
(eqlt -0.0 (- 0.0)) |
286 |
t) |
t) |