[prev in list] [next in list] [prev in thread] [next in thread] 

List:       sbcl-commits
Subject:    [Sbcl-commits] master: Don't assume that MACRO-FUNCTION returns a simple-fun.
From:       "Douglas Katzman" <snuglas () users ! sourceforge ! net>
Date:       2015-05-31 7:37:15
Message-ID: E1Yyxo6-0000ri-Np () sfs-ml-2 ! v29 ! ch3 ! sourceforge ! com
[Download RAW message or body]

The branch "master" has been updated in SBCL:
       via  bb805bdb31f980cc2b5168c779ed78d55accf504 (commit)
      from  e99219907c13d19dcc56ef25ebc9e2065e2345c9 (commit)

- Log -----------------------------------------------------------------
commit bb805bdb31f980cc2b5168c779ed78d55accf504
Author: Douglas Katzman <dougk@google.com>
Date:   Sun May 31 03:33:24 2015 -0400

    Don't assume that MACRO-FUNCTION returns a simple-fun.
    
    Also don't reinvent PROPER-LIST-P.
---
 NEWS                     |    4 ++++
 src/code/pprint.lisp     |   13 +++++++------
 tests/pprint.impure.lisp |   12 ++++++++++++
 3 files changed, 23 insertions(+), 6 deletions(-)

diff --git a/NEWS b/NEWS
index 1ead761..85350d9 100644
--- a/NEWS
+++ b/NEWS
@@ -11,6 +11,10 @@ changes relative to sbcl-1.2.12:
   * bug fix: calls to (SETF SLOT-VALUE) on a missing slot would in certain
     situations incorrectly return the result of a SLOT-MISSING method
     instead of always returning the new value. (lp#1460381)
+  * bug fix: a DEFMACRO occurring not at toplevel and capturing parts of
+    its lexical environment (thus being a closure) caused expressions
+    involving the macro name to cause corruption in the pretty-printer
+    due to faulty introspection of the lambda list of a closure.
 
 changes in sbcl-1.2.12 relative to sbcl-1.2.11:
   * minor incompatible change: the SB-C::*POLICY* variable is no longer
diff --git a/src/code/pprint.lisp b/src/code/pprint.lisp
index 42aa06f..f7b637c 100644
--- a/src/code/pprint.lisp
+++ b/src/code/pprint.lisp
@@ -1442,11 +1442,12 @@ line break."
 ;;; the first N arguments specially then indent any further arguments
 ;;; like a body.
 (defun macro-indentation (name)
-  (labels ((proper-list-p (list)
-             (not (nth-value 1 (ignore-errors (list-length list)))))
-           (macro-arglist (name)
-             (%simple-fun-arglist (macro-function name)))
-           (clean-arglist (arglist)
+  (labels ((clean-arglist (arglist)
+             ;; FIXME: for purposes of introspection, we should never "leak"
+             ;; that a macro uses an &AUX variable, that it takes &WHOLE,
+             ;; or that it cares about its lexenv (though that's debatable).
+             ;; Certainly the first two aspects are not part of the macro's
+             ;; interface, and as such, should not be stored at all.
              "Remove &whole, &enviroment, and &aux elements from ARGLIST."
              (cond ((null arglist) '())
                    ((member (car arglist) '(&whole &environment))
@@ -1454,7 +1455,7 @@ line break."
                    ((eq (car arglist) '&aux)
                     '())
                    (t (cons (car arglist) (clean-arglist (cdr arglist)))))))
-    (let ((arglist (macro-arglist name)))
+    (let ((arglist (%fun-lambda-list (macro-function name))))
       (if (proper-list-p arglist)       ; guard against dotted arglists
           (position '&body (remove '&optional (clean-arglist arglist)))
           nil))))
diff --git a/tests/pprint.impure.lisp b/tests/pprint.impure.lisp
index e1d3199..2d54b52 100644
--- a/tests/pprint.impure.lisp
+++ b/tests/pprint.impure.lisp
@@ -398,4 +398,16 @@
   (assert (string= (write-to-string (cons 'known-cons (cons 'known-cons t)) :pretty t)
                    "#<KNOWN-CONS #<KNOWN-CONS T>>")))
 
+;; force MACDADDY to be a closure over X.
+(let ((x 3)) (defmacro macdaddy (a b &body z) a b z `(who-cares ,x)) (incf x))
+
+(with-test (:name :closure-macro-arglist)
+  ;; assert correct test setup - MACDADDY is a closure
+  (assert (eq (sb-kernel:fun-subtype (macro-function 'macdaddy))
+              sb-vm:closure-header-widetag))
+  ;; MACRO-INDENTATION used %simple-fun-arglist instead of %fun-arglist.
+  ;; Depending on your luck it would either not return the right answer,
+  ;; or crash, depending on what lay at 4 words past the function address.
+  (assert (= (sb-pretty::macro-indentation 'macdaddy) 2)))
+
 ;;; success

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL

------------------------------------------------------------------------------
_______________________________________________
Sbcl-commits mailing list
Sbcl-commits@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/sbcl-commits
[prev in list] [next in list] [prev in thread] [next in thread]