From: Alexey Dejneka <adejneka@comail.ru>
Date: Thu, 27 Mar 2003 07:28:59 +0000 (+0000)
Subject: 0.pre8.11:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=f422a2ce49eb30a01ce71935eaadeb92badc41a4;p=sbcl.git

0.pre8.11:
	Fixed evaluation order in optional entries (reported by
	Gilbert Baumann in #lisp 2003-03-26).
---

diff --git a/NEWS b/NEWS
index faa9abc..c7ff1eb 100644
--- a/NEWS
+++ b/NEWS
@@ -1629,6 +1629,8 @@ changes in sbcl-0.8.0 relative to sbcl-0.7.14
   * fixed a bug in computing method discriminating functions: it is
     now possible to define methods specialized on classes which have
     forward-referenced superclasses.  (thanks to Gerd Moellmann)
+  * fixed evaluation order in optional entries. (reported by Gilbert
+    Baumann)
   * fixed some bugs revealed by Paul Dietz' test suite:
     ** COPY-ALIST now signals an error if its argument is a dotted
        list;
diff --git a/src/compiler/ir1-translators.lisp b/src/compiler/ir1-translators.lisp
index 7177de5..ab89de1 100644
--- a/src/compiler/ir1-translators.lisp
+++ b/src/compiler/ir1-translators.lisp
@@ -530,15 +530,17 @@
   During evaluation of the Forms, bind the Vars to the result of evaluating the
   Value forms. The variables are bound in parallel after all of the Values are
   evaluated."
-  (multiple-value-bind (forms decls) (parse-body body nil)
-    (multiple-value-bind (vars values) (extract-let-vars bindings 'let)
-      (let ((fun-cont (make-continuation)))
-        (let* ((*lexenv* (process-decls decls vars nil cont))
-               (fun (ir1-convert-lambda-body
-                     forms vars
-                     :debug-name (debug-namify "LET ~S" bindings))))
-          (reference-leaf start fun-cont fun))
-        (ir1-convert-combination-args fun-cont cont values)))))
+  (if (null bindings)
+      (ir1-translate-locally  body start cont)
+      (multiple-value-bind (forms decls) (parse-body body nil)
+        (multiple-value-bind (vars values) (extract-let-vars bindings 'let)
+          (let ((fun-cont (make-continuation)))
+            (let* ((*lexenv* (process-decls decls vars nil cont))
+                   (fun (ir1-convert-lambda-body
+                         forms vars
+                         :debug-name (debug-namify "LET ~S" bindings))))
+              (reference-leaf start fun-cont fun))
+            (ir1-convert-combination-args fun-cont cont values))))))
 
 (def-ir1-translator let* ((bindings &body body)
 			  start cont)
diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp
index 3a3376a..c5f7b41 100644
--- a/src/compiler/ir1tran.lisp
+++ b/src/compiler/ir1tran.lisp
@@ -1535,12 +1535,21 @@
 			      :where-from (leaf-where-from var)
 			      :specvar (lambda-var-specvar var)))
 			   fvars))
-	 (fun (ir1-convert-lambda-body `((%funcall ,fun
-						   ,@(reverse vals)
-						   ,@defaults))
-				       arg-vars
-				       :debug-name "&OPTIONAL processor"
-                                       :note-lexical-bindings nil)))
+	 (fun (collect ((default-bindings)
+                        (default-vals))
+                (dolist (default defaults)
+                  (if (constantp default)
+                      (default-vals default)
+                      (let ((var (gensym)))
+                        (default-bindings `(,var ,default))
+                        (default-vals var))))
+                (ir1-convert-lambda-body `((let (,@(default-bindings))
+                                             (%funcall ,fun
+                                                       ,@(reverse vals)
+                                                       ,@(default-vals))))
+                                         arg-vars
+                                         :debug-name "&OPTIONAL processor"
+                                         :note-lexical-bindings nil))))
     (mapc (lambda (var arg-var)
 	    (when (cdr (leaf-refs arg-var))
 	      (setf (leaf-ever-used var) t)))
diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index b58bbea..8154102 100644
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -332,3 +332,8 @@
        ((lambda (&optional *x* &rest y) (declare (special *x*)) (values *x* y)) nil))
    for real-warns-p = (nth-value 1 (compile nil fun))
    do (assert (eq warns-p real-warns-p)))
+
+;;; Bug reported by Gilbert Baumann on #lisp IRC 2003-03-26
+(assert (equal (funcall (eval '(lambda (x &optional (y (pop x))) (list x y)))
+                        '(1 2))
+               '((2) 1)))
diff --git a/version.lisp-expr b/version.lisp-expr
index 71fcd84..965ab00 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -18,4 +18,4 @@
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 
-"0.pre8.10"
+"0.pre8.11"