/[gcl]/gcl/ansi-tests/set-syntax-from-char.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/set-syntax-from-char.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.4 by pfdietz, Sun Jan 30 14:08:48 2005 UTC revision 1.5 by pfdietz, Sat Feb 5 16:45:40 2005 UTC
# Line 77  Line 77 
77                     (set-syntax-from-char c #\\)                     (set-syntax-from-char c #\\)
78                     (read-from-string (concatenate 'string (list c #\Z))))))                     (read-from-string (concatenate 'string (list c #\Z))))))
79               (unless (equal results '(t |Z|))               (unless (equal results '(t |Z|))
80                 (list c results))))))                 (list (list c results)))))))
81    nil)    nil)
82    
83  (deftest set-syntax-from-char.multiple-escape  (deftest set-syntax-from-char.multiple-escape
# Line 99  Line 99 
99                      (read-from-string (concatenate 'string (list #\| #\Z c)))                      (read-from-string (concatenate 'string (list #\| #\Z c)))
100                      (error (c) c)))))                      (error (c) c)))))
101               (unless (or (eql c #\Z) (eql c #\z) (equal results '(t |Z| |z| |Z|)))               (unless (or (eql c #\Z) (eql c #\z) (equal results '(t |Z| |z| |Z|)))
102                 (list c results))))))                 (list (list c results)))))))
103    nil)    nil)
104    
105  (deftest set-syntax-from-char.semicolon  (deftest set-syntax-from-char.semicolon
# Line 123  Line 123 
123                      (read-from-string (concatenate 'string (list c #\2 #\Newline c2)))                      (read-from-string (concatenate 'string (list c #\2 #\Newline c2)))
124                      (error (c) c)))))                      (error (c) c)))))
125               (unless (equal results (list t expected expected expected))               (unless (equal results (list t expected expected expected))
126                 (list c results))))))                 (list (list c results)))))))
127    nil)    nil)
                     
128    
129    (deftest set-syntax-from-char.left-paren
130      (loop for c across +standard-chars+
131            unless (find c ")")
132            nconc
133            (with-standard-io-syntax
134             (let ((*readtable* (copy-readtable nil))
135                   (*package* (find-package "CL-TEST"))
136                   (expected (if (eql c #\0) '(1) '(0)))
137                   (c2 (if (eql c #\0) #\1 #\0)))
138               (let ((results
139                      (list
140                       (set-syntax-from-char c #\()
141                       (handler-case
142                        (read-from-string (concatenate 'string (list c) ")"))
143                        (error (c) c))
144                       (handler-case
145                        (read-from-string (concatenate 'string (list c c2) ")2" (list #\Newline #\3)))
146                        (error (c) c))
147                       (handler-case
148                        (read-from-string (concatenate 'string (list c c2) ")"))
149                        (error (c) c)))))
150                 (unless (equal results (list t nil expected expected))
151                   (list (list c results)))))))
152      nil)
153    
154    (deftest set-syntax-from-char.right-paren
155      (loop for c across +standard-chars+
156            nconc
157            (with-standard-io-syntax
158             (let ((*readtable* (copy-readtable nil))
159                   (*package* (find-package "CL-TEST")))
160               (let ((results
161                      (list
162                       (set-syntax-from-char c #\))
163                       (handler-case
164                        (read-from-string (string c) nil nil)
165                        (reader-error (c) :good)
166                        (error (c) c)))))
167                 (unless (equal results '(t :good))
168                   (list (list c results)))))))
169      nil)
170    
171    (deftest set-syntax-from-char.single-quote
172      (loop for c across +standard-chars+
173            nconc
174            (with-standard-io-syntax
175             (let ((*readtable* (copy-readtable nil))
176                   (*package* (find-package "CL-TEST"))
177                   (expected (if (eql c #\0) ''1 ''0))
178                   (c2 (if (eql c #\0) #\1 #\0)))
179               (let ((results
180                      (list
181                       (set-syntax-from-char c #\')
182                       (handler-case
183                        (read-from-string (concatenate 'string (list c c2)))
184                        (error (c) c))
185                       (handler-case
186                        (read-from-string (concatenate 'string (list c c2) " 2"))
187                        (error (c) c))
188                       (handler-case
189                        (read-from-string (concatenate 'string (list c c2) ")"))
190                        (error (c) c)))))
191                 (unless (equal results (list t expected expected expected))
192                   (list (list c results)))))))
193      nil)
194    
195    ;;; I do not test that setting syntax from #\" allows the character to be
196    ;;; used as the terminator of a double quoted string.  It is not clear that
197    ;;; the standard implies this.
198    
199    (deftest set-syntax-from-char.double-quote
200      (loop for c across +standard-chars+
201            nconc
202            (with-standard-io-syntax
203             (let ((*readtable* (copy-readtable nil))
204                   (*package* (find-package "CL-TEST"))
205                   (expected (if (eql c #\0) "1" "0"))
206                   (c2 (if (eql c #\0) #\1 #\0)))
207               (let ((results
208                      (list
209                       (set-syntax-from-char c #\")
210                       (handler-case
211                        (read-from-string
212                         (concatenate 'string (list c c2 #\")))
213                        (error (c) c))
214                       (handler-case
215                        (read-from-string
216                         (concatenate 'string (list c c2 #\" #\2)))
217                        (error (c) c))
218                       (handler-case
219                        (read-from-string (concatenate 'string (list c c2) "\")"))
220                        (error (c) c)))))
221                 (unless (equal results (list t expected expected expected))
222                   (list (list c results)))))))
223      nil)
224    
225    (deftest set-syntax-from-char.backquote
226      (loop for c across +standard-chars+
227            unless (find c ",x")
228            nconc
229            (with-standard-io-syntax
230             (let* ((*readtable* (copy-readtable nil))
231                    (*package* (find-package "CL-TEST"))
232                    (c2 (if (eql c #\Space) #\Newline #\Space))
233                    (results
234                     (list
235                      (set-syntax-from-char c #\`)
236                      (handler-case
237                       (eval `(let ((x 0))
238                                ,(read-from-string
239                                  (concatenate 'string (list c #\, #\x)))))
240                       (error (c) c))
241                      (handler-case
242                       (eval `(let ((x 0))
243                                ,(read-from-string
244                                  (concatenate 'string (list c #\, #\x c2)))))
245                       (error (c) c))
246                      (handler-case
247                       (eval `(let ((x 0))
248                                ,(read-from-string
249                                  (concatenate 'string (list c c2 #\, #\x c2)))))
250                       (error (c) c)))))
251               (unless (equal results '(t 0 0 0))
252                 (list (list c results))))))
253      nil)
254    
255    (deftest set-syntax-from-char.comma
256      (loop for c across +standard-chars+
257            unless (find c "`x")
258            nconc
259            (with-standard-io-syntax
260             (let* ((*readtable* (copy-readtable nil))
261                    (*package* (find-package "CL-TEST"))
262                    (c2 (if (eql c #\Space) #\Newline #\Space))
263                    (results
264                     (list
265                      (set-syntax-from-char c #\,)
266                      (handler-case
267                       (read-from-string (string c))
268                       (reader-error (c) :good)
269                       (error (c) c))
270                      (handler-case
271                       (eval `(let ((x 0))
272                                ,(read-from-string
273                                  (concatenate 'string "`" (list c) "x"))))
274                       (error (c) c)))))
275               (unless (equal results '(t :good 0))
276                 (list (list c results))))))
277      nil)
278                  
279    ;;; Tests of set-syntax-from-char on #\#
280    
281    (deftest set-syntax-from-char.sharp.1
282      (loop for c across +standard-chars+
283            nconc
284            (with-standard-io-syntax
285             (let* ((*readtable* (copy-readtable nil))
286                    (*package* (find-package "CL-TEST"))
287                    (results
288                     (list
289                      (set-syntax-from-char c #\#)
290                      (if (not (eql c #\Space))
291                          (handler-case
292                           (read-from-string
293                            (concatenate 'string (list c #\Space)))
294                           (reader-error () :good)
295                           (error (c) c))
296                        :good)
297                      (if (not (find c "'X"))
298                          (handler-case
299                           (read-from-string
300                            (concatenate 'string (list c) "'X"))
301                           (error (c) c))
302                        '#'|X|)
303                      (if (not (find c "(X)"))
304                          (handler-case
305                           (read-from-string
306                            (concatenate 'string (list c) "(X)"))
307                           (error (c) c))
308                        #(|X|))
309                      (if (not (find c ")"))
310                          (handler-case
311                           (read-from-string
312                            (concatenate 'string (list c) ")"))
313                           (reader-error (c) :good)
314                           (error (c) c))
315                        :good)
316                      (if (not (find c "*"))
317                          (handler-case
318                           (read-from-string
319                            (concatenate 'string (list c #\*)))
320                           (error (c) c))
321                        #*)
322                      (if (not (find c ":|"))
323                          (handler-case
324                           (let ((sym (read-from-string
325                                       (concatenate 'string (list c) ":||"))))
326                             (and (symbolp sym)
327                                  (null (symbol-package sym))
328                                  (symbol-name sym)))
329                           (error (c) c))
330                        "")
331                      (handler-case
332                       (read-from-string
333                        (concatenate 'string (list c #\<)))
334                       (reader-error (c) :good)
335                       (error (c) c))
336                      (handler-case
337                       (read-from-string
338                        (concatenate 'string (list c #\\ #\X)))
339                       (error (c) c))
340                      (if (not (find c "1"))
341                          (handler-case
342                           (read-from-string
343                            (concatenate 'string (list c) "|1111|#1"))
344                           (error (c) c))
345                        1)
346                      (if (not (find c "1"))
347                          (handler-case
348                           (read-from-string
349                            (concatenate 'string (list c) "|11#|111|#11|#1"))
350                           (error (c) c))
351                        1)
352                      )))
353               (unless (equalp results '(t :good #'|X| #(|X|) :good #* "" :good #\X 1 1))
354                 (list (list c results))))))
355      nil)
356    
357    (deftest set-syntax-from-char.sharp.2
358      (loop for c across +standard-chars+
359            nconc
360            (with-standard-io-syntax
361             (let* ((*readtable* (copy-readtable nil))
362                    (*package* (find-package "CL-TEST"))
363                    (results
364                     (list
365                      (set-syntax-from-char c #\#)
366                      (if (not (find c "+XC "))
367                          (handler-case
368                           (let ((*features* (cons ':X *features*)))
369                             (read-from-string
370                              (concatenate 'string (list c) "+X C")))
371                           (error (c) c))
372                        'c)
373                      (if (not (find c "-(OR)"))
374                          (handler-case
375                           (read-from-string
376                            (concatenate 'string (list c) "-(OR)R"))
377                           (error (c) c))
378                        'r)
379                      (if (not (find c ".1"))
380                          (handler-case
381                           (read-from-string
382                            (concatenate 'string (list c) ".1"))
383                           (error (c) c))
384                        1)
385                      (if (not (find c "01aA"))
386                          (handler-case
387                           (list
388                            (read-from-string
389                             (concatenate 'string (list c) "0a1"))
390                            (read-from-string
391                             (concatenate 'string (list c) "0A1")))
392                           (error (c) c))
393                        '(#0a1 #0a1))
394                      (if (not (find c "01bB"))
395                          (handler-case
396                           (list
397                            (read-from-string
398                             (concatenate 'string (list c) "b101"))
399                            (read-from-string
400                             (concatenate 'string (list c) "B011")))
401                           (error (c) c))
402                        '(5 3))
403                      (if (not (find c "cC()12 "))
404                          (handler-case
405                           (list
406                            (read-from-string
407                             (concatenate 'string (list c) "c(1 2)"))
408                            (read-from-string
409                             (concatenate 'string (list c) "C(2 1)")))
410                           (error (c) c))
411                        '(#c(1 2) #c(2 1)))
412                      (if (not (find c "oO0127"))
413                          (handler-case
414                           (list
415                            (read-from-string
416                             (concatenate 'string (list c) "o172"))
417                            (read-from-string
418                             (concatenate 'string (list c) "O7721")))
419                           (error (c) c))
420                        '(#o172 #o7721))
421                      (if (not (find c "pP\""))
422                          (handler-case
423                           (list
424                            (read-from-string
425                             (concatenate 'string (list c) "p\"\""))
426                            (read-from-string
427                             (concatenate 'string (list c) "P\"\"")))
428                           (error (c) c))
429                        '(#p"" #p""))
430                      (if (not (find c "rR0123"))
431                          (handler-case
432                           (list
433                            (read-from-string
434                             (concatenate 'string (list c) "3r210"))
435                            (read-from-string
436                             (concatenate 'string (list c) "3R1111")))
437                           (error (c) c))
438                        '(#3r210 #3r1111))
439                      ;;; Add #s test here
440                      (if (not (find c "xX04dF"))
441                          (handler-case
442                           (list
443                            (read-from-string
444                             (concatenate 'string (list c) "x40Fd"))
445                            (read-from-string
446                             (concatenate 'string (list c) "XFd04")))
447                           (error (c) c))
448                        '(#x40fd #xfd04))
449                      )))
450               (unless (equalp results
451                               '(t c r 1 (#0a1 #0a1) (5 3) (#c(1 2) #c(2 1))
452                                   (#o172 #o7721) (#p"" #p"") (#3r210 #3r1111)
453                                   (#x40fd #xfd04)))
454                 (list (list c results)))
455               )))
456      nil)
457    
458    

Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26