changeset 5462:97ac18bd1fa3

Make sure distinct symbol macros with identical names expand distinctly. lisp/ChangeLog addition: 2011-04-24 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (symbol-macrolet): * cl-macs.el (lexical-let): * cl.el: * cl.el (cl-macroexpand): Distinct symbol macros with identical string names should nonetheless expand to different things; implement this, storing the symbol's eq-hash in the macro environment, rather than its string name. tests/ChangeLog addition: 2011-04-24 Aidan Kehoe <kehoea@parhasard.net> * automated/lisp-tests.el: Check that distinct symbol macros with identical string names expand to different things.
author Aidan Kehoe <kehoea@parhasard.net>
date Sun, 24 Apr 2011 09:52:45 +0100
parents 568ec109e73d
children 2b79584091b7
files lisp/ChangeLog lisp/cl-macs.el lisp/cl.el tests/ChangeLog tests/automated/lisp-tests.el
diffstat 5 files changed, 52 insertions(+), 12 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Sat Apr 23 22:42:10 2011 +0100
+++ b/lisp/ChangeLog	Sun Apr 24 09:52:45 2011 +0100
@@ -1,3 +1,14 @@
+2011-04-24  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* cl-macs.el (symbol-macrolet):
+	* cl-macs.el (lexical-let):
+	* cl.el:
+	* cl.el (cl-macroexpand):
+	Distinct symbol macros with identical string names should
+	nonetheless expand to different things; implement this, storing
+	the symbol's eq-hash in the macro environment, rather than its
+	string name.
+
 2011-04-23  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* cl-extra.el (define-char-comparisons):
--- a/lisp/cl-macs.el	Sat Apr 23 22:42:10 2011 +0100
+++ b/lisp/cl-macs.el	Sun Apr 24 09:52:45 2011 +0100
@@ -1791,12 +1791,14 @@
   "Make symbol macro definitions.
 Within the body FORMs, references to the variable NAME will be replaced
 by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...)."
+  (check-type name symbol)
   (cl-macroexpand-all (cons 'progn form)
-                      (append (list (list (symbol-name name) expansion))
-                              (loop
-                                for (name expansion) in symbol-macros
-                                collect (list (symbol-name name) expansion))
-                              cl-macro-environment)))
+                      (nconc (list (list (eq-hash name) expansion))
+			     (loop
+			       for (name expansion) in symbol-macros
+			       do (check-type name symbol)
+			       collect (list (eq-hash name) expansion))
+			     cl-macro-environment)))
 
 (defvar cl-closure-vars nil)
 ;;;###autoload
@@ -1807,8 +1809,9 @@
   (let* ((cl-closure-vars cl-closure-vars)
 	 (vars (mapcar #'(lambda (x)
 			   (or (consp x) (setq x (list x)))
-			   (push (gensym (format "--%s--" (car x)))
-				    cl-closure-vars)
+			   (push (gensym (concat "--" (symbol-name (car x))
+						 "--" ))
+				 cl-closure-vars)
 			   (set (car cl-closure-vars) [bad-lexical-ref])
 			   (list (car x) (cadr x) (car cl-closure-vars)))
 		       bindings))
@@ -1816,7 +1819,7 @@
 	  (cl-macroexpand-all
 	   (cons 'progn body)
 	   (nconc (mapcar #'(lambda (x)
-			      (list (symbol-name (car x))
+			      (list (eq-hash (car x))
 				    (list 'symbol-value (caddr x))
 				    t))
 			  vars)
--- a/lisp/cl.el	Sat Apr 23 22:42:10 2011 +0100
+++ b/lisp/cl.el	Sun Apr 24 09:52:45 2011 +0100
@@ -229,11 +229,17 @@
 
 The second optional arg ENVIRONMENT specifies an environment of macro
 definitions to shadow the loaded ones for use in file byte-compilation."
-  (let ((cl-macro-environment cl-env))
-    (while (progn (setq cl-macro (funcall cl-old-macroexpand cl-macro cl-env))
+  (let ((cl-macro-environment
+	 (if cl-macro-environment (append cl-env cl-macro-environment) cl-env))
+	eq-hash)
+    (while (progn (setq cl-macro
+			(macroexpand-internal cl-macro cl-macro-environment))
 		  (and (symbolp cl-macro)
-		       (cdr (assq (symbol-name cl-macro) cl-env))))
-      (setq cl-macro (cadr (assq (symbol-name cl-macro) cl-env))))
+		       (setq eq-hash (eq-hash cl-macro))
+		       (if (fixnump eq-hash)
+			   (assq eq-hash cl-macro-environment)
+			 (assoc eq-hash cl-macro-environment))))
+      (setq cl-macro (cadr (assoc* eq-hash cl-macro-environment))))
     cl-macro))
 
 ;;; Declarations.
--- a/tests/ChangeLog	Sat Apr 23 22:42:10 2011 +0100
+++ b/tests/ChangeLog	Sun Apr 24 09:52:45 2011 +0100
@@ -1,3 +1,9 @@
+2011-04-24  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* automated/lisp-tests.el:
+	Check that distinct symbol macros with identical string names
+	expand to different things.
+
 2011-03-24  Jerry James  <james@xemacs.org>
 
 	* automated/query-coding-tests.el: "Compatiblity" -> "Compatibility".
--- a/tests/automated/lisp-tests.el	Sat Apr 23 22:42:10 2011 +0100
+++ b/tests/automated/lisp-tests.el	Sun Apr 24 09:52:45 2011 +0100
@@ -2914,4 +2914,18 @@
 	"the function special operator doesn't create a lexical context."))
     (Assert (eql 0 (needs-lexical-context 2 nil nil)))))
 
+;; Test symbol-macrolet with symbols with identical string names.
+
+(macrolet
+    ((test-symbol-macrolet ()
+       (let* ((symbol 'my-symbol)
+	      (copy-symbol (copy-symbol symbol))
+	      (third (copy-symbol copy-symbol)))
+	 `(symbol-macrolet ((,symbol [symbol expansion])
+			    (,copy-symbol [copy expansion])
+			    (,third [third expansion]))
+	   (list ,symbol ,copy-symbol ,third)))))
+  (Assert (equal '([symbol expansion] [copy expansion] [third expansion])
+		 (test-symbol-macrolet))))
+
 ;;; end of lisp-tests.el