Prevent set-syntax-from-char from crashing remhash

Because the empty extended-char table is not a hash-table.
But now it's OK to maphash over.
This commit is contained in:
Douglas Katzman 2020-06-24 15:19:48 -04:00
parent 7bebe3387d
commit a5d97a3dec
2 changed files with 12 additions and 7 deletions

View file

@ -109,9 +109,9 @@
(setf table (make-hash-table :test 'eq)
(extended-char-table readtable) table))
(setf (gethash char table) (cons attributes function)))
(t
;; If the table is *empty-extended-char-table* the item won't be
;; found, so we're not actually altering the empty table.
((neq table *empty-extended-char-table*)
;; can't REMHASH from *empty-extended-char-table*
;; since it's not a real hash-table.
(remhash char table)))))
nil)
@ -1981,10 +1981,8 @@ extended <package-name>::<form-in-package> syntax."
(push (cons char output) alist)))))
(loop for fn across (base-char-macro-array readtable) and ch from 0
do (process (code-char ch) fn))
(unless (eq (extended-char-table readtable) *empty-extended-char-table*)
;; very unsafe to maphash over the empty table - it's a stub object
(maphash (lambda (char val) (process char (cdr val)))
(extended-char-table readtable))))
(maphash (lambda (char val) (process char (cdr val)))
(extended-char-table readtable)))
alist))
(declaim (inline character-macro-array character-macro-hash-table))

View file

@ -242,6 +242,10 @@
#+sb-unicode
(with-test (:name :unicode-dispatch-macros)
;; Smoke test: (set-syntax-from-char unicode-char ordinary-constituent-char)
;; should not fail
(set-syntax-from-char (code-char 300) #\a)
;;
(let ((*readtable* (copy-readtable)))
(make-dispatch-macro-character (code-char #x266F)) ; musical sharp
(set-dispatch-macro-character
@ -252,6 +256,9 @@
(let ((x (read-from-string
(map 'string #'code-char '(#x266F #x221E)))))
(assert (eq x :infinity))
;; I don't know what this was testing, and it's "noisy". Can we fix that?
;; I think we used to treat NIL as *removing* the macro function, which is not
;; a specified action. But neither could NIL ever be a function designator.
(set-dispatch-macro-character (code-char #x266F) (code-char #x221E) nil)
(assert (zerop (hash-table-count
(cdr (sb-impl::%dispatch-macro-char-table