diff options
author | Douglas Katzman <dougk@google.com> | 2014-05-01 19:27:53 -0400 |
---|---|---|
committer | Douglas Katzman <dougk@google.com> | 2014-05-01 19:27:53 -0400 |
commit | 324ceef1264d3ea6ea563a1fc78311265670e856 (patch) | |
tree | ef81810bba91610a266e83104db3b1b66cb0fd27 /tests/reader.impure.lisp | |
parent | dda79f80dfd0dfc6f07a820c9df436a7bd97cbdf (diff) |
Slightly unbreak named-readtables per my latest changes.
The compatibility API that is exposed for dispatching characters
can coerce fdefns to symbols, but there is still a problem that
non-dispatching character functions are groveled out and passed
to SET-MACRO-CHARACTER which won't work in general.
Related problem in sb-cover - it did not understand that
GET-MACRO-CHARACTER could return a function-designator.
Diffstat (limited to 'tests/reader.impure.lisp')
-rw-r--r-- | tests/reader.impure.lisp | 30 |
1 files changed, 29 insertions, 1 deletions
diff --git a/tests/reader.impure.lisp b/tests/reader.impure.lisp index 1bcfcd8aa..616cc7779 100644 --- a/tests/reader.impure.lisp +++ b/tests/reader.impure.lisp @@ -255,7 +255,35 @@ (set-syntax-from-char (code-char #xbeef) #\a) (set-syntax-from-char (code-char #xfeed) #\b) (set-syntax-from-char (code-char 35) #\a) ; sharp is dead - (assert (null (sb-impl::dispatch-tables *readtable*))))) + (assert (null (sb-impl::dispatch-tables *readtable*)))) + + ;; Ensure the interface provided for named-readtables remains somewhat intact. + (let ((*readtable* (copy-readtable))) + (make-dispatch-macro-character #\@) + (set-dispatch-macro-character #\@ #\a 'read-at-a) + (set-dispatch-macro-character #\@ #\$ 'read-at-dollar) + (set-dispatch-macro-character #\@ #\* #'sb-impl::sharp-star) + ;; Enter exactly one character in the Unicode range because + ;; iteratation order is arbitrary and assert would be fragile. + ;; ASCII characters are naturally ordered by code. + (set-dispatch-macro-character #\@ (code-char #x2010) 'read-blah) + (let ((rt (copy-readtable *readtable*))) + ;; Don't want to assert about all the standard noise, + ;; and also don't want to kill the ability to write #\char + (set-syntax-from-char #\# #\a rt) + (assert (equal (sb-impl::dispatch-tables rt nil) + `((#\@ (#\A . read-at-a) + (#\* . ,#'sb-impl::sharp-star) + (#\$ . read-at-dollar) + (#\hyphen . read-blah)))))) + ;; this removes one entry rather than entering NIL in the hashtable + (set-dispatch-macro-character #\@ (code-char #x2010) nil) + (let ((rt (copy-readtable *readtable*))) + (set-syntax-from-char #\# #\a rt) + (assert (equal (sb-impl::dispatch-tables rt nil) + `((#\@ (#\A . read-at-a) + (#\* . ,#'sb-impl::sharp-star) + (#\$ . read-at-dollar)))))))) (with-test (:name :copy-dispatching-macro) (let ((*readtable* (copy-readtable))) |