From cd47bf77acd0b3355641fbd8da21c1157cb59502 Mon Sep 17 00:00:00 2001
From: Brian Mastenbrook <bmastenb@cs.indiana.edu>
Date: Sat, 10 Sep 2005 22:12:43 +0000
Subject: [PATCH] 0.9.4.58: 	* Fix problem where TYPEP in compiled code
 could return a           true-or-false answer on a bad
 literal type specifier.

---
 src/compiler/typetran.lisp |   73 ++++++++++++++++++++++----------------------
 version.lisp-expr          |    2 +-
 2 files changed, 38 insertions(+), 37 deletions(-)

diff --git a/src/compiler/typetran.lisp b/src/compiler/typetran.lisp
index 71061b0..b601e7a 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 67c9914..b0fe04d 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"
-- 
1.7.10.4