diff options
| -rw-r--r-- | lisp/emacs-lisp/macroexp.el | 28 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/macroexp-tests.el | 16 |
2 files changed, 29 insertions, 15 deletions
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 290bf1c933a..083a7f58f36 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -227,21 +227,19 @@ It should normally be a symbol with position and it defaults to FORM." (defun macroexp-macroexpand (form env) "Like `macroexpand' but checking obsolescence." (let* ((macroexpand-all-environment env) - (new-form - (macroexpand form env))) - (if (and (not (eq form new-form)) ;It was a macro call. - (car-safe form) - (symbolp (car form)) - (get (car form) 'byte-obsolete-info)) - (let* ((fun (car form)) - (obsolete (get fun 'byte-obsolete-info))) - (macroexp-warn-and-return - (macroexp--obsolete-warning - fun obsolete - (if (symbolp (symbol-function fun)) - "alias" "macro")) - new-form (list 'obsolete fun) nil fun)) - new-form))) + new-form) + (while (not (eq form (setq new-form (macroexpand-1 form env)))) + (let ((fun (car-safe form))) + (setq form + (if (and fun (symbolp fun) + (get fun 'byte-obsolete-info)) + (macroexp-warn-and-return + (macroexp--obsolete-warning + fun (get fun 'byte-obsolete-info) + (if (symbolp (symbol-function fun)) "alias" "macro")) + new-form (list 'obsolete fun) nil fun) + new-form)))) + form)) (defun macroexp--unfold-lambda (form &optional name) (or name (setq name "anonymous lambda")) diff --git a/test/lisp/emacs-lisp/macroexp-tests.el b/test/lisp/emacs-lisp/macroexp-tests.el index 7bb38fe58f7..d0efbfd28c1 100644 --- a/test/lisp/emacs-lisp/macroexp-tests.el +++ b/test/lisp/emacs-lisp/macroexp-tests.el @@ -124,4 +124,20 @@ (dyn dyn dyn dyn) (dyn dyn dyn lex)))))) +(defmacro macroexp--test-macro1 () + (declare (obsolete "new-replacement" nil)) + 1) + +(defmacro macroexp--test-macro2 () + '(macroexp--test-macro1)) + +(ert-deftest macroexp--test-obsolete-macro () + (should + (let ((res + (cl-letf (((symbol-function 'message) #'user-error)) + (condition-case err + (macroexpand-all '(macroexp--test-macro2)) + (user-error (error-message-string err)))))) + (should (and (stringp res) (string-match "new-replacement" res)))))) + ;;; macroexp-tests.el ends here |