From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Mon, 27 Feb 2006 15:03:08 +0000 (+0000)
Subject: 0.9.10.5: correct CONSTANTP
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;ds=sidebyside;h=6769a6cdb368694f39f9c0e2b6790f45cf308b91;p=sbcl.git

0.9.10.5: correct CONSTANTP
 * fix thinko in interactions between PROGV & IF and add a test to catch
    it.
---

diff --git a/src/compiler/constantp.lisp b/src/compiler/constantp.lisp
index 41a69d6..721e594 100644
--- a/src/compiler/constantp.lisp
+++ b/src/compiler/constantp.lisp
@@ -200,10 +200,13 @@ constantness of the FORM in ENVIRONMENT."
  (defconstantp progv (symbols values &body forms)
    :test (and (constantp* symbols)
               (constantp* values)
-              (let ((*special-constant-variables*
-                     (append (constant-form-value* symbols)
-                              *special-constant-variables*)))
-                (every #'constantp* forms)))
+              (let* ((symbol-values (constant-form-value* symbols))
+                     (*special-constant-variables*
+                      (append symbol-values *special-constant-variables*)))
+                (progv
+                    symbol-values
+                    (constant-form-value* values)
+                  (every #'constantp* forms))))
    :eval (progv
              (constant-form-value* symbols)
              (constant-form-value* values)
diff --git a/tests/eval.impure.lisp b/tests/eval.impure.lisp
index 6b6293d..bf6141d 100644
--- a/tests/eval.impure.lisp
+++ b/tests/eval.impure.lisp
@@ -128,12 +128,14 @@
                      '(x)
                      '(1)
                    (1+ x))              t         2)
-		((unwind-protect 1 nil) t         1)
-		((unwind-protect 1
-		   (xxx))               nil)
-		((the integer 1)        t         1)
-		((the integer (+ 1 1))  t         2)
-		((the integer (foo))    nil)
+		((progv '(x) '(t)
+		   (if x 1 2))          t         1)
+                ((unwind-protect 1 nil) t         1)
+                ((unwind-protect 1
+                   (xxx))               nil)
+                ((the integer 1)        t         1)
+                ((the integer (+ 1 1))  t         2)
+                ((the integer (foo))    nil)
                 ((+ 1 2)                t         3)))
   (destructuring-bind (form c &optional v) test
     (assert (eql (constantp form) c))
diff --git a/version.lisp-expr b/version.lisp-expr
index a0cb646..6469097 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.4"
+"0.9.10.5"