0.7.13.16:

        Disable checking of *xxx*-like lexical variable names in
        optional- and more-entries (see, e.g., bug 240).

diff --git a/BUGS b/BUGS
index 6f0011c..08fea20 100644 (file)
--- a/BUGS
+++ b/BUGS
@@ -1270,22 +1270,6 @@ WORKAROUND:
   compiler gets its hands on the code needing compilation from the REPL,
   it has been macroexpanded several times.
 
-240:
-  "confused lexical/special warnings in MULTIPLE-VALUE-BIND"
-  (from tonyms on #lisp IRC 2003-02-25)
-  In sbcl-0.7.12.55, compiling 
-    (cl:in-package :cl-user)
-    (defvar *foo* 0)
-    (defvar *bar* 1)
-    (defun bar ()
-      (multiple-value-bind (*foo* *bar*) 'eleventy-one
-        (bletch)))
-    (defun bletch () (format t "~&*FOO*=~S *BAR*=~S" *foo* *bar*))
-    (bar)
-  gives warnings like "using the lexical binding of the symbol *FOO*"
-  even though LOADing the fasl file shows that in fact the special
-  bindings are being used.
-
 241:
   "DEFCLASS mysteriously remembers uninterned accessor names."
   (from tonyms on #lisp IRC 2003-02-25)

diff --git a/NEWS b/NEWS
index df41ba2..9d069f5 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1590,6 +1590,9 @@ changes in sbcl-0.7.14 relative to sbcl-0.7.13:
     ** the type system is now able to reason about the interaction
        between INTEGER and RATIO types more completely;
   * fixed CEILING optimization for a divisor of form 2^k.
+  * fixed bug 240 (emitting extra style warnings "using the lexical
+    binding of the symbol *XXX*" for &OPTIONAL arguments). (reported
+    by Antonio Martinez)
 
 planned incompatible changes in 0.7.x:
   * (not done yet, but planned:) When the profiling interface settles

diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp
index e081c85..38866b9 100644 (file)
--- a/src/compiler/ir1tran.lisp
+++ b/src/compiler/ir1tran.lisp
@@ -1437,7 +1437,8 @@
                                aux-vals
                                result
                                (source-name '.anonymous.)
-                               debug-name)
+                               debug-name
+                                (note-lexical-bindings t))
   (declare (list body vars aux-vars aux-vals)
           (type (or continuation null) result))
 
@@ -1473,7 +1474,8 @@
                 (svars var)
                 (new-venv (cons (leaf-source-name specvar) specvar)))
                (t
-                (note-lexical-binding (leaf-source-name var))
+                 (when note-lexical-bindings
+                   (note-lexical-binding (leaf-source-name var)))
                 (new-venv (cons (leaf-source-name var) var))))))
 
       (let ((*lexenv* (make-lexenv :vars (new-venv)
@@ -1481,7 +1483,7 @@
                                   :cleanup nil)))
        (setf (bind-lambda bind) lambda)
        (setf (node-lexenv bind) *lexenv*)
-       
+
        (let ((cont1 (make-continuation))
              (cont2 (make-continuation)))
          (continuation-starts-block cont1)
@@ -1522,8 +1524,6 @@
   (declare (type clambda fun) (list vars vals defaults))
   (let* ((fvars (reverse vars))
         (arg-vars (mapcar (lambda (var)
-                            (unless (lambda-var-specvar var)
-                              (note-lexical-binding (leaf-source-name var)))
                             (make-lambda-var
                              :%source-name (leaf-source-name var)
                              :type (leaf-type var)
@@ -1534,7 +1534,8 @@
                                                   ,@(reverse vals)
                                                   ,@defaults))
                                       arg-vars
-                                      :debug-name "&OPTIONAL processor")))
+                                      :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)))
@@ -1705,7 +1706,8 @@
                     (%funcall ,(optional-dispatch-main-entry res)
                               ,@(arg-vals))))
                 (arg-vars)
-                :debug-name (debug-namify "~S processing" '&more))))
+                :debug-name (debug-namify "~S processing" '&more)
+                 :note-lexical-bindings nil)))
        (setf (optional-dispatch-more-entry res) ep))))
 
   (values))

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 130a5af..b58bbea 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -321,3 +321,14 @@
     (assert (= i 1))
     (assert (= (funcall fn) 1))
     (assert (= i 1))))
+
+;;; Bug 240 reported by tonyms on #lisp IRC 2003-02-25 (modified version)
+(loop for (fun warns-p) in
+     '(((lambda (&optional *x*) *x*) t)
+       ((lambda (&optional *x* &rest y) (values *x* y)) t)
+       ((lambda (&optional *print-base*) (values *print-base*)) nil)
+       ((lambda (&optional *print-base* &rest y) (values *print-base* y)) nil)
+       ((lambda (&optional *x*) (declare (special *x*)) (values *x*)) nil)
+       ((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)))

diff --git a/version.lisp-expr b/version.lisp-expr
index 084ce2a..6118e0d 100644 (file)
--- 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.7.13.15"
+"0.7.13.16"