1.0.28.12: preserve non-toplevelness of macro subforms

 * As per CLHS 3.2.3.1.2. At least AND, OR, and COND where affected by
   this. Reported by James Knight.

diff --git a/NEWS b/NEWS
index 7f2c767..728ef57 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -4,6 +4,9 @@
   * optimization: multidimensional array accesses in the absence of type
     information regarding array rank are approximately 10% faster due to
     open coding of ARRAY-RANK.
+  * bug fix: some forms of AND, OR, and COND resulted in expansions that could
+    result in their subforms being treated as top level forms. (reported by
+    James Knight)
   * bug fix: disable address space randomization Linux/x86-64 as well,
     not just x86-64. (reported by Ken Olum)
   * bug fix: #201; type inference for CONS and ARRAY types could derive

diff --git a/src/code/defboot.lisp b/src/code/defboot.lisp
index 581c994..6642fc2 100644 (file)
--- a/src/code/defboot.lisp
+++ b/src/code/defboot.lisp
@@ -82,7 +82,9 @@
                            ,n-result
                            (cond ,@more))))
                   (if (eq t test)
-                      `(progn ,@forms)
+                      ;; THE to perserve non-toplevelness for FOO in
+                      ;;   (COND (T (FOO)))
+                      `(the t (progn ,@forms))
                       `(if ,test
                            (progn ,@forms)
                            ,(when more `(cond ,@more))))))))))
@@ -101,7 +103,9 @@ evaluated as a PROGN."
 
 (defmacro-mundanely and (&rest forms)
   (cond ((endp forms) t)
-        ((endp (rest forms)) (first forms))
+        ((endp (rest forms))
+         ;; Preserve non-toplevelness of the form!
+         `(the t ,(first forms)))
         (t
          `(if ,(first forms)
               (and ,@(rest forms))
@@ -109,7 +113,9 @@ evaluated as a PROGN."
 
 (defmacro-mundanely or (&rest forms)
   (cond ((endp forms) nil)
-        ((endp (rest forms)) (first forms))
+        ((endp (rest forms))
+         ;; Preserve non-toplevelness of the form!
+         `(the t ,(first forms)))
         (t
          (let ((n-result (gensym)))
            `(let ((,n-result ,(first forms)))

diff --git a/tests/compiler.test.sh b/tests/compiler.test.sh
index 0a479eb..6a816df 100644 (file)
--- a/tests/compiler.test.sh
+++ b/tests/compiler.test.sh
@@ -398,5 +398,12 @@ cat > $tmpfilename <<EOF
 EOF
 expect_clean_cload $tmpfilename
 
+cat > $tmpfilename <<EOF
+(and (eval-when (:compile-toplevel) (error "oops AND")))
+(or (eval-when (:compile-toplevel) (error "oops OR")))
+(cond (t (eval-when (:compile-toplevel) (error "oops COND"))))
+EOF
+expect_clean_cload $tmpfilename
+
 # success
 exit $EXIT_TEST_WIN

diff --git a/version.lisp-expr b/version.lisp-expr
index 57e10fb..de59ab4 100644 (file)
--- 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.28.11"
+"1.0.28.12"