From f71445c16693bf12ac835a46763e1dfb25a6db0a Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Thu, 12 May 2011 10:02:27 +0000 Subject: [PATCH 1/1] 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. --- src/code/reader.lisp | 22 ++++++++++++---------- tests/reader.pure.lisp | 11 +++++++++++ version.lisp-expr | 2 +- 3 files changed, 24 insertions(+), 11 deletions(-) diff --git a/src/code/reader.lisp b/src/code/reader.lisp index 4fd79a7..56b8ac1 100644 --- 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 --- 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 --- 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" -- 1.7.10.4