Skip to content

Commit

Permalink
0.9.13.20:
Browse files Browse the repository at this point in the history
	Merge sbcl-devel patch "NAME-CHAR and unrecognised symbols" by
        Robert J. Macomber, fixing an issue with NAME-CHAR signaling an error
        when given an invalid symbol.
  • Loading branch information
jsnell committed Jun 1, 2006
1 parent b8a2248 commit cfc1753
Show file tree
Hide file tree
Showing 4 changed files with 14 additions and 9 deletions.
2 changes: 2 additions & 0 deletions NEWS
Expand Up @@ -16,6 +16,8 @@ changes in sbcl-0.9.14 relative to sbcl-0.9.13:
* bug fix: saving large (>2GB) cores on x86-64 now works
* bug fix: a x86-64 backend bug when compiling (setf aref) with a
constant index and a (simple-array (signed-byte 32)) array
* bug fix: NAME-CHAR on an invalid symbol no longer signals an
error (patch by Robert J. Macomber)
* fixed some bugs revealed by Paul Dietz' test suite:
** MISC.641: LET-conversion were not supposed to work in late
compilation stages.
Expand Down
17 changes: 9 additions & 8 deletions src/code/target-char.lisp
Expand Up @@ -271,20 +271,21 @@
(let ((encoding (huffman-encode (string-upcase name)
*unicode-character-name-huffman-tree*)))
(when encoding
(let ((char-code
(car (binary-search encoding
(cdr *unicode-character-name-database*)
:key #'cdr)))
(name-length (length name)))
(let* ((char-code
(car (binary-search encoding
(cdr *unicode-character-name-database*)
:key #'cdr)))
(name-string (string name))
(name-length (length name-string)))
(cond
(char-code
(code-char char-code))
((and (or (= name-length 9)
(= name-length 5))
(char-equal (char name 0) #\U)
(char-equal (char name-string 0) #\U)
(loop for i from 1 below name-length
always (digit-char-p (char name i) 16)))
(code-char (parse-integer name :start 1 :radix 16)))
always (digit-char-p (char name-string i) 16)))
(code-char (parse-integer name-string :start 1 :radix 16)))
(t
nil)))))))

Expand Down
2 changes: 2 additions & 0 deletions tests/character.pure.lisp
Expand Up @@ -71,3 +71,5 @@
(name (char-name char)))
(unless graphicp
(assert name))))

(assert (null (name-char 'foo)))
2 changes: 1 addition & 1 deletion version.lisp-expr
Expand Up @@ -17,4 +17,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".)
"0.9.13.19"
"0.9.13.20"

0 comments on commit cfc1753

Please sign in to comment.