0.9.10.26

  * fixed endless loop on (SUBTYPEP NULL (OR UNK0 UNK1)) in the cross compiler

diff --git a/src/code/cross-type.lisp b/src/code/cross-type.lisp
index 79b8cd1..0ac13c9 100644 (file)
--- a/src/code/cross-type.lisp
+++ b/src/code/cross-type.lisp
@@ -341,10 +341,23 @@
 ;;; cross-compile time only.
 (defun ctypep (obj ctype)
   (check-type ctype ctype)
-  (let (;; the Common Lisp type specifier corresponding to CTYPE
-        (type (type-specifier ctype)))
-    (check-type type (or symbol cons))
-    (cross-typep obj type)))
+  ;; There is at least one possible endless recursion in the
+  ;; cross-compiler type system: (SUBTYPEP NULL (OR UNKOWN0 UNKNOWN1)
+  ;; runs out of stack. The right way would probably be to not
+  ;; implement CTYPEP in terms of TYPE-SPECIFIER (:UNPARSE, that may
+  ;; call TYPE=, that in turn may call CTYPEP). Until then, pick a few
+  ;; cherries off.
+  (cond ((member-type-p ctype)
+         (if (member obj (member-type-members ctype))
+             (values t t)
+             (values nil t)))
+        ((union-type-p ctype)
+         (any/type #'ctypep obj (union-type-types ctype)))
+        (t
+         (let ( ;; the Common Lisp type specifier corresponding to CTYPE
+               (type (type-specifier ctype)))
+           (check-type type (or symbol cons))
+           (cross-typep obj type)))))
 
 (defun ctype-of (x)
   (typecase x

diff --git a/tests/type.before-xc.lisp b/tests/type.before-xc.lisp
index 380f930..77f484f 100644 (file)
--- a/tests/type.before-xc.lisp
+++ b/tests/type.before-xc.lisp
@@ -283,6 +283,11 @@
     (sb-xc:subtypep '(function) '(function (t &rest t)))
   (assert (not yes))
   (assert win))
+;; Used to run out of stack.
+(multiple-value-bind (yes win)
+    (sb-xc:subtypep 'null '(or unk0 unk1))
+  (assert (not yes))
+  (assert (not win)))
 
 (multiple-value-bind (yes win)
     (sb-xc:subtypep '(and function instance) nil)

diff --git a/version.lisp-expr b/version.lisp-expr
index c5f2b3f..acc015b 100644 (file)
--- 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.10.25"
+"0.9.10.26"