From cd8fe50554652680dde36396d7862fc6cc83839c Mon Sep 17 00:00:00 2001 From: Gabor Melis Date: Thu, 9 Mar 2006 13:05:22 +0000 Subject: [PATCH] 0.9.10.26 * fixed endless loop on (SUBTYPEP NULL (OR UNK0 UNK1)) in the cross compiler --- src/code/cross-type.lisp | 21 +++++++++++++++++---- tests/type.before-xc.lisp | 5 +++++ version.lisp-expr | 2 +- 3 files changed, 23 insertions(+), 5 deletions(-) diff --git a/src/code/cross-type.lisp b/src/code/cross-type.lisp index 79b8cd1..0ac13c9 100644 --- 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 --- 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 --- 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" -- 1.7.10.4