1.0.48.13: SET-SYNTAX-FROM-CHAR and dispatch-macro characterness

  Previously when the to-char was a dispatch-macro character in to-readtable,
  but from-char wasn't one in from-readtable, SET-SYNTAX-FROM-CHAR didn't do
  anything.

  CLHS says "If the character is a dispatching macro character, its entire
  dispatch table of reader macro functions is copied." which *can* be taken to
  mean that dispatch table should not be removed even if it doesn't exist at
  all in the from-readtable, but that interpretation doesn't really match with
  the rest of the description or the exhortation to copy the syntax type -- I
  read it as an instruction to copy the whole dispatch table, not just the
  fact that the character is a dispatching macro character.

diff --git a/src/code/reader.lisp b/src/code/reader.lisp
index 4fd79a7..56b8ac1 100644 (file)
--- a/src/code/reader.lisp
+++ b/src/code/reader.lisp
@@ -250,17 +250,19 @@ standard Lisp readtable when NIL."
                           :test #'char= :key #'car)))
       (set-cat-entry to-char att to-readtable)
       (set-cmt-entry to-char mac to-readtable)
-      (when from-dpair
-        (cond
-          (to-dpair
-           (let ((table (cdr to-dpair)))
-             (clrhash table)
-             (shallow-replace/eql-hash-table table (cdr from-dpair))))
-          (t
-           (let ((pair (cons to-char (make-hash-table))))
-             (shallow-replace/eql-hash-table (cdr pair) (cdr from-dpair))
+      (cond ((and (not from-dpair) (not to-dpair)))
+            ((and (not from-dpair) to-dpair)
              (setf (dispatch-tables to-readtable)
-                   (push pair (dispatch-tables to-readtable)))))))))
+                   (remove to-dpair (dispatch-tables to-readtable))))
+            (to-dpair
+             (let ((table (cdr to-dpair)))
+               (clrhash table)
+               (shallow-replace/eql-hash-table table (cdr from-dpair))))
+            (t
+             (let ((pair (cons to-char (make-hash-table))))
+               (shallow-replace/eql-hash-table (cdr pair) (cdr from-dpair))
+               (setf (dispatch-tables to-readtable)
+                     (push pair (dispatch-tables to-readtable))))))))
   t)
 
 (defun set-macro-character (char function &optional

diff --git a/tests/reader.pure.lisp b/tests/reader.pure.lisp
index f0ba954..d5407e4 100644 (file)
--- a/tests/reader.pure.lisp
+++ b/tests/reader.pure.lisp
@@ -262,3 +262,14 @@
                   (read-from-string "`#2A((,(1+ 0) 0) (0 0))")
                 (reader-error ()
                   :error)))))
+
+(with-test (:name set-syntax-from-char-dispatch-macro-char)
+  (let ((rt (copy-readtable)))
+    (make-dispatch-macro-character #\! nil rt)
+    (set-dispatch-macro-character #\! #\! (constantly 'bang^2) rt)
+    (flet ((maybe-bang ()
+             (let ((*readtable* rt))
+               (read-from-string "!!"))))
+      (assert (eq 'bang^2 (maybe-bang)))
+      (set-syntax-from-char #\! #\! rt)
+      (assert (eq '!! (maybe-bang))))))

diff --git a/version.lisp-expr b/version.lisp-expr
index 28fc138..b03ad4f 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -20,4 +20,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.48.12"
+"1.0.48.13"