branch: externals/assess
commit e1b7740df50771b8eec5742f6910988e4a08b88f
Author: Phillip Lord <phillip.l...@russet.org.uk>
Commit: Phillip Lord <phillip.l...@russet.org.uk>
Add unwind-protect to assess-call functions
Previously these functions were messy and left advice or hooks around if
their lambda failed. This side-effect could call fail-over in tests.
This is now addressed.
---
assess-call.el | 27 +++++++++++++++------------
test/assess-call-test.el | 46 ++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 61 insertions(+), 12 deletions(-)
diff --git a/assess-call.el b/assess-call.el
index df5bfaa438..7e1b18d8cc 100644
--- a/assess-call.el
+++ b/assess-call.el
@@ -85,10 +85,11 @@ The return value is a list of cons cells, with car being the
parameters of the calls, and the cdr being the return value."
(let ((capture-lambda
(assess-call--capture-lambda)))
- (advice-add sym-fn :around capture-lambda)
- (funcall fn)
- (advice-remove sym-fn capture-lambda)
- (funcall capture-lambda :return)))
+ (unwind-protect
+ (progn (advice-add sym-fn :around capture-lambda)
+ (funcall fn)
+ (funcall capture-lambda :return))
+ (advice-remove sym-fn capture-lambda))))
(defun assess-call--hook-capture-lambda ()
"Returns a function which captures all of its args.
@@ -110,14 +111,16 @@ args."
APPEND and LOCAL are passed to `add-hook` and documented there."
(let ((capture-lambda
(assess-call--hook-capture-lambda)))
- (add-hook hook-var
- capture-lambda
- append local)
- (funcall fn)
- (remove-hook hook-var
- capture-lambda
- local)
- (funcall capture-lambda :return)))
+ (unwind-protect
+ (progn
+ (add-hook hook-var
+ capture-lambda
+ append local)
+ (funcall fn)
+ (funcall capture-lambda :return))
+ (remove-hook hook-var
+ capture-lambda
+ local))))
(provide 'assess-call)
;;; assess-call.el ends here
diff --git a/test/assess-call-test.el b/test/assess-call-test.el
index 8c243e78e5..46e9cf953e 100644
--- a/test/assess-call-test.el
+++ b/test/assess-call-test.el
@@ -26,6 +26,7 @@
;; #+begin_src emacs-lisp
(require 'ert)
+(require 'assess)
(require 'assess-call)
(defun assess-call-return-car (&rest args)
@@ -65,6 +66,36 @@
(assess-call-capture-multiply 1 2)
(assess-call-capture-multiply 3 4))))))
+(defun assess-call-adviced-p (symbol)
+ "Return non-nil if SYMBOL has advice."
+ ;; eeech
+ (let ((retn nil))
+ (advice-mapc
+ (lambda (&rest _)
+ (setq retn t))
+ symbol)
+ retn))
+
+(ert-deftest assess-call-test-capture-fail ()
+ (should-not
+ (assess-call-adviced-p 'assess-call-capture-multiply))
+ (should
+ (let ((retn nil))
+ (assess-call-capture
+ 'assess-call-capture-multiply
+ (lambda ()
+ (setq retn
+ (assess-call-adviced-p 'assess-call-capture-multiply))))
+ retn))
+ (should-not
+ (condition-case err
+ (assess-call-capture
+ 'assess-call-capture-multiply
+ (lambda ()
+ (signal 'assess-deliberate-error nil)))
+ (assess-deliberate-error
+ (assess-call-adviced-p 'assess-call-capture-multiply)))))
+
(defvar assess-call-test-hook nil)
(ert-deftest assess-call-test-hook-test ()
@@ -92,4 +123,19 @@
(run-hook-with-args 'assess-call-test-hook
'bob))))))
+
+(ert-deftest assess-call-test-hook-fail ()
+ ;; should be nil
+ (should (not assess-call-test-hook))
+ ;; and should be nil if we error
+ (should
+ (condition-case err
+ (assess-call-capture-hook
+ 'assess-call-test-hook
+ (lambda ()
+ (signal 'assess-deliberate-error nil)))
+ (assess-deliberate-error
+ (not assess-call-test-hook)))))
+
(provide 'assess-call-test)
+;;; assess-call-test ends here
