From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Sat, 18 Oct 2008 15:26:06 +0000 (+0000)
Subject: 1.0.21.31: fix bad PROGV and RESTRICT-COMPILER-POLICY interaction
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=d4cc0f4fe1dd40a6745abf74f778a32a805bbc9c;p=sbcl.git

1.0.21.31: fix bad PROGV and RESTRICT-COMPILER-POLICY interaction

 * Reported by Matthias Andreas Benkard Matthias Andreas Benkard.

 * Patch by Juho Snellman.
---

diff --git a/NEWS b/NEWS
index 27ca910..33888b7 100644
--- a/NEWS
+++ b/NEWS
@@ -44,6 +44,9 @@ changes in sbcl-1.0.22 relative to 1.0.21:
     update the system's knowledge about its call signature properly.
   * bug fix: fixed #431; incompatible alien record type redefinitions
     are detected and handled. (reported by Neil Haven)
+  * bug fix: using RESTRICT-COMPILER-POLICY with DEBUG 3 could cause
+    PROGV miscompilation. (reported by Matthias Benkard, patch by Juho
+    Snellman)
 
 changes in sbcl-1.0.21 relative to 1.0.20:
   * new feature: the compiler is able to track the effective type of a
diff --git a/src/compiler/ir2tran.lisp b/src/compiler/ir2tran.lisp
index ca486d1..b19e6fa 100644
--- a/src/compiler/ir2tran.lisp
+++ b/src/compiler/ir2tran.lisp
@@ -1437,7 +1437,8 @@
                               (about-to-modify-symbol-value var "bind ~S")
                               (%primitive bind unbound-marker var))))
                         (,bind (vars vals)
-                          (declare (optimize (speed 2) (debug 0)))
+                          (declare (optimize (speed 2) (debug 0)
+                                             (insert-debug-catch 0)))
                           (cond ((null vars))
                                 ((null vals) (,unbind vars))
                                 (t
diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 6f48dad..34aa2a0 100644
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -2651,3 +2651,16 @@
 (with-test (:name :hairy-function-name)
   (assert (eq 'read-line (nth-value 2 (function-lambda-expression #'read-line))))
   (assert (equal "#<FUNCTION READ-LINE>" (princ-to-string #'read-line))))
+
+;;; PROGV + RESTRICT-COMPILER-POLICY
+(with-test (:name :progv-and-restrict-compiler-policy)
+  (let ((sb-c::*policy-restrictions* sb-c::*policy-restrictions*))
+    (restrict-compiler-policy 'debug 3)
+    (let ((fun (compile nil '(lambda (x)
+                              (let ((i x))
+                                (declare (special i))
+                                (list i
+                                      (progv '(i) (list (+ i 1))
+                                        i)
+                                      i))))))
+      (assert (equal '(1 2 1) (funcall fun 1))))))
diff --git a/version.lisp-expr b/version.lisp-expr
index 1bc3c9f..6f12975 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".)
-"1.0.21.30"
+"1.0.21.31"