From: Alexey Dejneka <adejneka@comail.ru>
Date: Fri, 14 Apr 2006 17:57:57 +0000 (+0000)
Subject: 0.9.11.37:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=203e466f5fbb3bffa7b4beb19d87bed6f8a1b5db;p=sbcl.git

0.9.11.37:
        * Fix MISC.367: when delaying IR1-conversion of an optional
          entry replace default value forms with their values.
---

diff --git a/NEWS b/NEWS
index 7800e5a..f9c286b 100644
--- a/NEWS
+++ b/NEWS
@@ -48,6 +48,8 @@ changes in sbcl-0.9.12 relative to sbcl-0.9.11:
        structure accessors.
     ** printing characters should simply be printed by the FORMAT ~:C
        directive.
+    ** compiler failure when compiling functions with hairy constant
+       defaults for optional parameters.
 
 changes in sbcl-0.9.11 relative to sbcl-0.9.10:
   * new platform: experimental support for SBCL x86/Darwin, including
diff --git a/src/compiler/ctype.lisp b/src/compiler/ctype.lisp
index 32ed243..7927814 100644
--- a/src/compiler/ctype.lisp
+++ b/src/compiler/ctype.lisp
@@ -632,8 +632,8 @@
            ((lambda-var-arg-info arg)
             (let* ((info (lambda-var-arg-info arg))
                    (default (arg-info-default info))
-                   (def-type (when (constantp default)
-                               (ctype-of (eval default)))))
+                   (def-type (when (sb!xc:constantp default)
+                               (ctype-of (constant-form-value default)))))
               (ecase (arg-info-kind info)
                 (:keyword
                  (let* ((key (arg-info-key info))
diff --git a/src/compiler/ir1tran-lambda.lisp b/src/compiler/ir1tran-lambda.lisp
index 34a4cb0..c2ae9ae 100644
--- a/src/compiler/ir1tran-lambda.lisp
+++ b/src/compiler/ir1tran-lambda.lisp
@@ -463,22 +463,27 @@
     ;; problems: hidden references should not be established to
     ;; lambdas of kind NIL should not have (otherwise the compiler
     ;; might let-convert or delete them) and to variables.
-    (let ((name (or debug-name source-name))
-          (defaults (if supplied-p (list default nil) (list default))))
+    (let ((name (or debug-name source-name)))
       (if (or force
               supplied-p-p ; this entry will be of kind NIL
               (and (lambda-p ep) (eq (lambda-kind ep) nil)))
           (convert-optional-entry ep
                                   default-vars default-vals
-                                  defaults
+                                  (if supplied-p (list default nil) (list default))
                                   name)
-          (delay
-           (register-entry-point
-            (convert-optional-entry (force ep)
-                                    default-vars default-vals
-                                    defaults
-                                    name)
-            res))))))
+          (let* ((default `',(constant-form-value default))
+                 (defaults (if supplied-p (list default nil) (list default))))
+            ;; DEFAULT can contain a reference to a
+            ;; to-be-optimized-away function/block/tag, so better to
+            ;; reduce code now (but we possibly lose syntax checking
+            ;; in an unreachable code).
+            (delay
+             (register-entry-point
+              (convert-optional-entry (force ep)
+                                      default-vars default-vals
+                                      defaults
+                                      name)
+              res)))))))
 
 ;;; Create the MORE-ENTRY function for the OPTIONAL-DISPATCH RES.
 ;;; ENTRY-VARS and ENTRY-VALS describe the fixed arguments. REST is
diff --git a/src/compiler/proclaim.lisp b/src/compiler/proclaim.lisp
index 9dd4dc6..8381cd9 100644
--- a/src/compiler/proclaim.lisp
+++ b/src/compiler/proclaim.lisp
@@ -172,7 +172,7 @@
        (dolist (name args)
          (unless (symbolp name)
            (error "can't declare a non-symbol as SPECIAL: ~S" name))
-         (when (constantp name)
+         (when (sb!xc:constantp name)
            (error "can't declare a constant as SPECIAL: ~S" name))
          (with-single-package-locked-error
              (:symbol name "globally declaring ~A special"))
diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 0bfef0e..d0821f4 100644
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -2067,3 +2067,14 @@
                                        (- (+ source-day
                                              canonicalized-shift) 7)))))))
                result))))
+
+;;; MISC.637: incorrect delaying of conversion of optional entries
+;;; with hairy constant defaults
+(let ((f '(lambda ()
+  (labels ((%f11 (f11-2 &key key1)
+             (labels ((%f8 (f8-2 &optional (f8-5 (if nil (return-from %f11 0) 0)))
+                        :bad1))
+               (%f8 (%f8 0)))
+             :bad2))
+    :good))))
+  (assert (eq (funcall (compile nil f)) :good)))
diff --git a/version.lisp-expr b/version.lisp-expr
index 7b72fce..f0b501c 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.11.36"
+"0.9.11.37"