0.9.4.58:

	* Fix problem where TYPEP in compiled code could return a
          true-or-false answer on a bad literal type specifier.

2 files changed, 38 insertions, 37 deletions

diff --git a/src/compiler/typetran.lisp b/src/compiler/typetran.lisp
index 71061b0fb..b601e7a73 100644
--- a/src/compiler/typetran.lisp
+++ b/src/compiler/typetran.lisp
@@ -497,42 +497,43 @@
   ;; weird roundabout way. -- WHN 2001-03-18
   (if (and (consp spec) (eq (car spec) 'quote))
       (let ((type (careful-specifier-type (cadr spec))))
-        (or (when (not type)
-              (compiler-warn "illegal type specifier for TYPEP: ~S"
-                             (cadr spec))
-              `(%typep ,object ,spec))
-            (let ((pred (cdr (assoc type *backend-type-predicates*
-                                    :test #'type=))))
-              (when pred `(,pred ,object)))
-            (typecase type
-              (hairy-type
-               (source-transform-hairy-typep object type))
-              (negation-type
-               (source-transform-negation-typep object type))
-              (union-type
-               (source-transform-union-typep object type))
-              (intersection-type
-               (source-transform-intersection-typep object type))
-              (member-type
-               `(if (member ,object ',(member-type-members type)) t))
-              (args-type
-               (compiler-warn "illegal type specifier for TYPEP: ~S"
-                              (cadr spec))
-               `(%typep ,object ,spec))
-              (t nil))
-            (typecase type
-              (numeric-type
-               (source-transform-numeric-typep object type))
-              (classoid
-               `(%instance-typep ,object ,spec))
-              (array-type
-               (source-transform-array-typep object type))
-              (cons-type
-               (source-transform-cons-typep object type))
-              (character-set-type
-               (source-transform-character-set-typep object type))
-              (t nil))
-            `(%typep ,object ,spec)))
+        (block bail
+          (or (when (not type)
+                (compiler-warn "illegal type specifier for TYPEP: ~S"
+                               (cadr spec))
+                (return-from bail (values nil t)))
+              (let ((pred (cdr (assoc type *backend-type-predicates*
+                                      :test #'type=))))
+                (when pred `(,pred ,object)))
+              (typecase type
+                (hairy-type
+                 (source-transform-hairy-typep object type))
+                (negation-type
+                 (source-transform-negation-typep object type))
+                (union-type
+                 (source-transform-union-typep object type))
+                (intersection-type
+                 (source-transform-intersection-typep object type))
+                (member-type
+                 `(if (member ,object ',(member-type-members type)) t))
+                (args-type
+                 (compiler-warn "illegal type specifier for TYPEP: ~S"
+                                (cadr spec))
+                 (return-from bail (values nil t)))
+                (t nil))
+              (typecase type
+                (numeric-type
+                 (source-transform-numeric-typep object type))
+                (classoid
+                 `(%instance-typep ,object ,spec))
+                (array-type
+                 (source-transform-array-typep object type))
+                (cons-type
+                 (source-transform-cons-typep object type))
+                (character-set-type
+                 (source-transform-character-set-typep object type))
+                (t nil))
+              `(%typep ,object ,spec))))
       (values nil t)))
 
 ;;;; coercion
diff --git a/version.lisp-expr b/version.lisp-expr
index 67c991413..b0fe04d0f 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -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.4.57"
+"0.9.4.58"