From: Alexey Dejneka <adejneka@comail.ru>
Date: Sun, 31 Oct 2004 05:34:22 +0000 (+0000)
Subject: 0.8.16.19:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=063f2d867cfdfee8a7cbab17e6c5054d9c6f3ad1;p=sbcl.git

0.8.16.19:
        * Fix bug MISC.435: disable SUBSTITUTE-SINGLE-USE-LVAR when a
          ref is inside a block to be deleted.
---

diff --git a/NEWS b/NEWS
index be5f03d..1c35f54 100644
--- a/NEWS
+++ b/NEWS
@@ -37,6 +37,8 @@ changes in sbcl-0.8.17 relative to sbcl-0.8.16:
   * fixed some bugs revealed by Paul Dietz' test suite:
     ** RENAME-PACKAGE allows all package designators as new package
        names.
+    ** constraint propagation and lambda variable substitution are
+       more cautious in dealing with partially deleted code.
 
 changes in sbcl-0.8.16 relative to sbcl-0.8.15:
   * enhancement: saving cores with foreign code loaded is now
diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index 820fcf4..28f338a 100644
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -1321,6 +1321,7 @@
            ;; LVAR-USEs should not be met on one path. Another problem
            ;; is with dynamic-extent.
            (eq (lvar-uses lvar) ref)
+           (not (block-delete-p (node-block ref)))
            (typecase dest
              ;; we should not change lifetime of unknown values lvars
              (cast
diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 36741f4..9072fbb 100644
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -1536,3 +1536,21 @@
      (print (if (< iv1 iv1)
                 (logand (ash iv1 iv1) 1)
                 iv1)))))
+
+;;; MISC.435: lambda var substitution in a deleted code.
+(assert (zerop (funcall
+   (compile
+    nil
+    '(lambda (a b c d)
+       (declare (notinline aref logandc2 gcd make-array))
+       (declare
+	(optimize (space 0) (safety 0) (compilation-speed 3)
+		  (speed 3) (debug 1)))
+       (progn
+	 (tagbody
+	  (let* ((v2 (make-array nil :initial-element (catch 'ct1 (go tag2)))))
+	    (declare (dynamic-extent v2))
+	    (gcd (go tag2) (logandc2 (catch 'ct2 c) (aref v2))))
+	  tag2)
+	 0)))
+   3021871717588 -866608 -2 -17194)))
diff --git a/version.lisp-expr b/version.lisp-expr
index 9ce3a00..1ffc130 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.8.16.18"
+"0.8.16.19"