carbon2-commit: Make sure distinct symbol macros with identical names expand distinctly.

changeset: 5465:97ac18bd1fa3 user: Aidan Kehoe <kehoea(a)parhasard.net&gt; date: Sun Apr 24 09:52:45 2011 +0100 files: lisp/ChangeLog lisp/cl-macs.el lisp/cl.el tests/ChangeLog tests/automated/lisp-tests.el description: Make sure distinct symbol macros with identical names expand distinctly. lisp/ChangeLog addition: 2011-04-24 Aidan Kehoe <kehoea(a)parhasard.net&gt; * 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(a)parhasard.net&gt; * automated/lisp-tests.el: Check that distinct symbol macros with identical string names expand to different things. diff -r 568ec109e73d -r 97ac18bd1fa3 lisp/ChangeLog --- 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(a)parhasard.net&gt; + + * 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(a)parhasard.net&gt; * cl-extra.el (define-char-comparisons): diff -r 568ec109e73d -r 97ac18bd1fa3 lisp/cl-macs.el --- 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) diff -r 568ec109e73d -r 97ac18bd1fa3 lisp/cl.el --- 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. diff -r 568ec109e73d -r 97ac18bd1fa3 tests/ChangeLog --- 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(a)parhasard.net&gt; + + * automated/lisp-tests.el: + Check that distinct symbol macros with identical string names + expand to different things. + 2011-03-24 Jerry James <james(a)xemacs.org&gt; * automated/query-coding-tests.el: "Compatiblity" -> "Compatibility". diff -r 568ec109e73d -r 97ac18bd1fa3 tests/automated/lisp-tests.el --- 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 _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches