From 2d199c38017184ff74aedef2aa9c4320d596f46e Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Tue, 5 Mar 2002 16:25:43 +0000 Subject: [PATCH] 0.7.1.30: merged APD bug 150 patch sbcl-devel 2002-03-05 --- src/compiler/constraint.lisp | 90 +++++++++++++++++++++--------------------- tests/compiler.impure.lisp | 23 ++++++++++- version.lisp-expr | 2 +- 3 files changed, 68 insertions(+), 47 deletions(-) diff --git a/src/compiler/constraint.lisp b/src/compiler/constraint.lisp index a302245..e2be093 100644 --- a/src/compiler/constraint.lisp +++ b/src/compiler/constraint.lisp @@ -126,50 +126,52 @@ (add-complement-constraints if 'typep (ok-ref-lambda-var use) (specifier-type 'null) t)) (combination - (let ((name (continuation-fun-name - (basic-combination-fun use))) - (args (basic-combination-args use))) - (case name - ((%typep %instance-typep) - (let ((type (second args))) - (when (constant-continuation-p type) - (let ((val (continuation-value type))) - (add-complement-constraints if 'typep - (ok-cont-lambda-var (first args)) - (if (ctype-p val) - val - (specifier-type val)) - nil))))) - ((eq eql) - (let* ((var1 (ok-cont-lambda-var (first args))) - (arg2 (second args)) - (var2 (ok-cont-lambda-var arg2))) - (cond ((not var1)) - (var2 - (add-complement-constraints if 'eql var1 var2 nil)) - ((constant-continuation-p arg2) - (add-complement-constraints if 'eql var1 - (ref-leaf - (continuation-use arg2)) - nil))))) - ((< >) - (let* ((arg1 (first args)) - (var1 (ok-cont-lambda-var arg1)) - (arg2 (second args)) - (var2 (ok-cont-lambda-var arg2))) - (when var1 - (add-complement-constraints if name var1 (continuation-type arg2) - nil)) - (when var2 - (add-complement-constraints if (if (eq name '<) '> '<) - var2 (continuation-type arg1) - nil)))) - (t - (let ((ptype (gethash name *backend-predicate-types*))) - (when ptype - (add-complement-constraints if 'typep - (ok-cont-lambda-var (first args)) - ptype nil)))))))) + (unless (eq (combination-kind use) + :error) + (let ((name (continuation-fun-name + (basic-combination-fun use))) + (args (basic-combination-args use))) + (case name + ((%typep %instance-typep) + (let ((type (second args))) + (when (constant-continuation-p type) + (let ((val (continuation-value type))) + (add-complement-constraints if 'typep + (ok-cont-lambda-var (first args)) + (if (ctype-p val) + val + (specifier-type val)) + nil))))) + ((eq eql) + (let* ((var1 (ok-cont-lambda-var (first args))) + (arg2 (second args)) + (var2 (ok-cont-lambda-var arg2))) + (cond ((not var1)) + (var2 + (add-complement-constraints if 'eql var1 var2 nil)) + ((constant-continuation-p arg2) + (add-complement-constraints if 'eql var1 + (ref-leaf + (continuation-use arg2)) + nil))))) + ((< >) + (let* ((arg1 (first args)) + (var1 (ok-cont-lambda-var arg1)) + (arg2 (second args)) + (var2 (ok-cont-lambda-var arg2))) + (when var1 + (add-complement-constraints if name var1 (continuation-type arg2) + nil)) + (when var2 + (add-complement-constraints if (if (eq name '<) '> '<) + var2 (continuation-type arg1) + nil)))) + (t + (let ((ptype (gethash name *backend-predicate-types*))) + (when ptype + (add-complement-constraints if 'typep + (ok-cont-lambda-var (first args)) + ptype nil))))))))) (values)) ;;; Set the TEST-CONSTRAINT in the successors of BLOCK according to diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp index 1025f37..459e522 100644 --- a/tests/compiler.impure.lisp +++ b/tests/compiler.impure.lisp @@ -53,11 +53,30 @@ (when (and (digs) (digs)) x)))) ;;; Bug 132: The compiler used to fail to compile INTEGER-valued CATCH -;;; tags. This was fixed by Alexey Dejneka in sbcl-0.7.1.14. (They're -;;; still a bad idea because tags are compared with EQ, but now it's a +;;; tags. This was fixed by Alexey Dejneka in sbcl-0.7.1.14. (INTEGER +;;; catch tags are still a bad idea because EQ is used to compare +;;; tags, and EQ comparison on INTEGERs is unportable; but now it's a ;;; compiler warning instead of a failure to compile.) (defun foo () (catch 0 (print 1331))) + +;;; Bug 150: In sbcl-0.7.1.15, compiling this code caused a failure in +;;; SB-C::ADD-TEST-CONSTRAINTS: +;;; The value NIL is not of type SB-C::CONTINUATION. +;;; This bug was fixed by APD in sbcl-0.7.1.30. +(defun bug150-test1 () + (let* () + (flet ((wufn () (glorp table1 4.9))) + (gleep *uustk* #'wufn "#1" (list))) + (if (eql (lo foomax 3.2)) + (values) + (error "not ~S" '(eql (lo foomax 3.2)))) + (values))) +;;; A simpler test case for bug 150: The compiler died with the +;;; same type error when trying to compile this. +(defun bug150-test2 () + (let () + (<))) ;;;; tests not in the problem domain, but of the consistency of the ;;;; compiler machinery itself diff --git a/version.lisp-expr b/version.lisp-expr index 269673d..ebd9fed 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; for internal versions, especially for internal versions off the ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.7.1.29" +"0.7.1.30" -- 1.7.10.4