1 files changed, 42 insertions, 0 deletions
diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el
index b779aa27888..21da038dc1c 100644
--- a/lisp/emacs-lisp/nadvice.el
+++ b/lisp/emacs-lisp/nadvice.el
@@ -318,6 +318,22 @@ is also interactive.  There are 3 cases:
 
 ;;;###autoload
 (defun advice--add-function (where ref function props)
+  (when (and (boundp 'comp-ctxt)
+             (subr-primitive-p (gv-deref ref)))
+    (let ((subr-name (intern (subr-name (gv-deref ref)))))
+      ;; Requiring the native compiler to advice `macroexpand' cause a
+      ;; circular dependency in eager macro expansion.
+      ;; uniquify is advising `rename-buffer' while being loaded in
+      ;; loadup.el.  This would require the whole native compiler
+      ;; machinery but we don't want to include it in the dump.
+      ;; Because these two functions are already handled in
+      ;; `comp-never-optimize-functions' we hack the problem this way
+      ;; for now :/
+      (unless (memq subr-name '(macroexpand rename-buffer))
+        ;; Must require explicitly as during bootstrap we have no
+        ;; autoloads.
+        (require 'comp)
+        (comp-subr-safe-advice subr-name))))
   (let* ((name (cdr (assq 'name props)))
          (a (advice--member-p (or name function) (if name t) (gv-deref ref))))
     (when a
@@ -340,6 +356,32 @@ of the piece of advice."
     (macroexp-let2 nil new `(advice--remove-function ,getter ,function)
       `(unless (eq ,new ,getter) ,(funcall setter new)))))
 
+;;;###autoload
+(defmacro advice-flet (bindings &rest body)
+  ;; FIXME add doc.
+  (declare (indent 1))
+  (let ((let-binds ())
+        (ad-add ())
+        (ad-del ()))
+    (dolist (bind bindings)
+      (let* ((fun-name (car bind))
+             (fun (cadr bind))
+             (tmp-sym (gensym (symbol-name fun-name))))
+        (push `(,tmp-sym ,fun) let-binds)
+        (push `(advice-add #',fun-name
+                           ,(if (= (length bind) 3)
+                                (nth 2 bind)
+                              :override)
+                           ,tmp-sym)
+              ad-add)
+        (push `(advice-remove #',fun-name ,tmp-sym) ad-del)))
+    `(let ,(reverse let-binds)
+       (unwind-protect
+	   (progn
+	     ,@(reverse ad-add)
+	     ,@body)
+	 ,@(reverse ad-del)))))
+
 (defun advice-function-mapc (f function-def)
   "Apply F to every advice function in FUNCTION-DEF.
 F is called with two arguments: the function that was added, and the