From 97698cd441721fbd216f0294606d144de8865b4c Mon Sep 17 00:00:00 2001
From: Lutz Euler <lutz.euler@freenet.de>
Date: Fri, 9 Dec 2011 21:25:08 +0100
Subject: [PATCH] Make COERCE on characters more standard-conforming.

Characters could be coerced to subtypes of CHARACTER to which they
don't belong. Also, character designators that are not characters
could be coerced to proper subtypes of CHARACTER. Make all of these
instead signal an error as required by CLHS COERCE.

Add test cases, both for unicode-enabled and non-unicode-enabled SBCL.

Fixes lp#841312.
---
 NEWS                      |    2 ++
 src/code/coerce.lisp      |    2 +-
 tests/character.pure.lisp |   33 +++++++++++++++++++++++++++++++++
 3 files changed, 36 insertions(+), 1 deletion(-)

diff --git a/NEWS b/NEWS
index f082d0d..eb6225e 100644
--- a/NEWS
+++ b/NEWS
@@ -76,6 +76,8 @@ changes relative to sbcl-1.0.54:
     an external entry point caused compiler-errors.
   * bug fix: compiler notes for failed stack allocation for a function argument
     no longer claim to be unable to stack allocate the function.
+  * bug fix: COERCE now signals a type-error on several coercions to
+    subtypes of CHARACTER that are forbidden according to ANSI. (lp#841312)
 
 changes in sbcl-1.0.54 relative to sbcl-1.0.53:
   * minor incompatible changes:
diff --git a/src/code/coerce.lisp b/src/code/coerce.lisp
index 81f27b2..8f1507e 100644
--- a/src/code/coerce.lisp
+++ b/src/code/coerce.lisp
@@ -122,7 +122,7 @@
          object)
         ((eq type *empty-type*)
          (coerce-error))
-        ((csubtypep type (specifier-type 'character))
+        ((type= type (specifier-type 'character))
          (character object))
         ((numberp object)
          (cond
diff --git a/tests/character.pure.lisp b/tests/character.pure.lisp
index e26fed4..015d347 100644
--- a/tests/character.pure.lisp
+++ b/tests/character.pure.lisp
@@ -85,3 +85,36 @@
                        c8 c9 ca cb cc cd ce cf))
              (char< c0 c1 c2 c3 c4 c5 c6 c7
               c8 c9 ca cb cc cd ce cf))))
+
+;;; Characters could be coerced to subtypes of CHARACTER to which they
+;;; don't belong. Also, character designators that are not characters
+;;; could be coerced to proper subtypes of CHARACTER.
+(with-test (:name :bug-841312)
+  ;; First let's make sure that the conditions hold that make the test
+  ;; valid: #\Nak is a BASE-CHAR, which at the same time ensures that
+  ;; STANDARD-CHAR is a proper subtype of BASE-CHAR, and under
+  ;; #+SB-UNICODE the character with code 955 exists and is not a
+  ;; BASE-CHAR.
+  (assert (typep #\Nak 'base-char))
+  #+sb-unicode
+  (assert (let ((c (code-char 955)))
+            (and c (not (typep c 'base-char)))))
+  ;; Test the formerly buggy coercions:
+  (macrolet ((assert-coerce-type-error (object type)
+               `(assert (raises-error? (coerce ,object ',type)
+                                       type-error))))
+    (assert-coerce-type-error #\Nak standard-char)
+    (assert-coerce-type-error #\a extended-char)
+    #+sb-unicode
+    (assert-coerce-type-error (code-char 955) base-char)
+    (assert-coerce-type-error 'a standard-char)
+    (assert-coerce-type-error "a" standard-char))
+  ;; The following coercions still need to be possible:
+  (macrolet ((assert-coercion (object type)
+               `(assert (typep (coerce ,object ',type) ',type))))
+    (assert-coercion #\a standard-char)
+    (assert-coercion #\Nak base-char)
+    #+sb-unicode
+    (assert-coercion (code-char 955) character)
+    (assert-coercion 'a character)
+    (assert-coercion "a" character)))
-- 
1.7.10.4