branch: elpa/with-simulated-input
commit 3525ed7dc591054e738d329d95059f8abeb5e7a4
Merge: ef9d5164ca 26fc928f42
Author: Ryan C. Thompson <[email protected]>
Commit: Ryan C. Thompson <[email protected]>
Merge branch 'bleeding-edge' into rewrite-bleed
---
Eldev | 11 +-
tests/test-unload.el | 80 +++++++++++
tests/test-with-simulated-input.el | 284 +++++++++++++++++++++++--------------
with-simulated-input.el | 8 +-
4 files changed, 270 insertions(+), 113 deletions(-)
diff --git a/Eldev b/Eldev
index 4967272da3..ed4367454c 100644
--- a/Eldev
+++ b/Eldev
@@ -1,14 +1,11 @@
-; -*- mode: emacs-lisp; lexical-binding: t; no-byte-compile: t -*-
+;; -*- mode: emacs-lisp; lexical-binding: t; no-byte-compile: t -*-
+
+(eldev-use-plugin 'undercover)
-;; Uncomment some calls below as needed for your project. It is not
-;; recommended to use `melpa-unstable' unless some dependencies simply
-;; cannot be downloaded from another archive.
(eldev-use-package-archive 'gnu)
-(eldev-use-package-archive 'melpa-stable)
+(eldev-use-package-archive 'melpa)
(setq eldev-test-framework 'buttercup)
-(eldev-add-extra-dependencies '(test emacs) 'undercover)
-
;; Tell checkdoc not to demand two spaces after a period.
(setq sentence-end-double-space nil)
diff --git a/tests/test-unload.el b/tests/test-unload.el
new file mode 100644
index 0000000000..423b1d4671
--- /dev/null
+++ b/tests/test-unload.el
@@ -0,0 +1,80 @@
+;;; -*- lexical-binding: t -*-
+
+(require 'buttercup)
+
+(require 'with-simulated-input)
+
+(defun has-advice (symbol advice)
+ (let ((advice-fun-to-find
+ ;; In Emacs 24, `indirect-function' throws an error instead
+ ;; of returning nil for void functions. We want it to return nil.
+ (ignore-errors (indirect-function advice)))
+ (found nil))
+ (when advice-fun-to-find
+ (advice-mapc
+ (lambda (ad-fun ad-props)
+ (let ((ad-fun-def (ignore-errors (indirect-function ad-fun))))
+ (when ad-fun-def
+ (setq found
+ (or found
+ (equal ad-fun-def advice-fun-to-find))))))
+ symbol))
+ found))
+
+(describe "The `with-simulated-input' library"
+
+ ;; Run each test with the library unloaded. Obviously this is not
+ ;; ideal since we are testing the unloading functionality, but
+ ;; there's not much else we can do. We reload the library after each
+ ;; test in order to restore the prior state.
+ (before-each
+ (when (featurep 'with-simulated-input)
+ (unload-feature 'with-simulated-input t)))
+ (after-each
+ (require 'with-simulated-input))
+
+ (it "should be able to load"
+ (expect (require 'with-simulated-input)
+ :not :to-throw))
+
+ (it "should apply the idle time advice when loading"
+ (require 'with-simulated-input)
+ (expect (has-advice #'current-idle-time
'current-idle-time@simulate-idle-time)
+ :to-be-truthy)
+ (spy-on 'current-idle-time@simulate-idle-time :and-call-through)
+ (current-idle-time)
+ (expect 'current-idle-time@simulate-idle-time
+ :to-have-been-called))
+
+ (it "should be able to unload"
+ ;; Load and unload 3 times, just to make sure there aren't errors
+ ;; on subsequent reloadings.
+ (expect (require 'with-simulated-input)
+ :not :to-throw)
+ (expect (featurep 'with-simulated-input))
+ (expect (unload-feature 'with-simulated-input t)
+ :not :to-throw)
+ (expect (not (featurep 'with-simulated-input)))
+ (expect (require 'with-simulated-input)
+ :not :to-throw)
+ (expect (featurep 'with-simulated-input))
+ (expect (unload-feature 'with-simulated-input t)
+ :not :to-throw)
+ (expect (not (featurep 'with-simulated-input)))
+ (expect (require 'with-simulated-input)
+ :not :to-throw)
+ (expect (featurep 'with-simulated-input))
+ (expect (unload-feature 'with-simulated-input t)
+ :not :to-throw)
+ (expect (not (featurep 'with-simulated-input))))
+
+ (it "should remove the idle time advice when unloading"
+ (expect (require 'with-simulated-input)
+ :not :to-throw)
+ (expect (has-advice #'current-idle-time
'current-idle-time@simulate-idle-time)
+ :to-be-truthy)
+ (expect (unload-feature 'with-simulated-input t)
+ :not :to-throw)
+ (expect (has-advice #'current-idle-time
'current-idle-time@simulate-idle-time)
+ :not :to-be-truthy)))
+;;; test-unload.el ends here
diff --git a/tests/test-with-simulated-input.el
b/tests/test-with-simulated-input.el
index e42d378713..8bf7448e1d 100644
--- a/tests/test-with-simulated-input.el
+++ b/tests/test-with-simulated-input.el
@@ -1,8 +1,5 @@
;;; -*- lexical-binding: t -*-
-(when (require 'undercover nil t)
- (undercover "with-simulated-input.el"))
-
(require 'with-simulated-input)
(require 'cl-lib)
(require 'buttercup)
@@ -11,6 +8,11 @@
(defvar my-collection)
(defvar my-non-lexical-var)
+(defun call-wsi-from-bytecomp-fun ()
+ (with-simulated-input "hello SPC world RET"
+ (read-string "Say hello: ")))
+(byte-compile 'call-wsi-from-bytecomp-fun)
+
(describe "`wsi-get-unbound-key'"
(it "should find an unbound key"
(let ((unbound-key (wsi-get-unbound-key)))
@@ -19,35 +21,178 @@
(it "should report an error if it fails to find an unbound key"
;; Now we call it with an empty list of modifiers and keys to
;; search, so it definitely should not find a binding.
- (expect (wsi-get-unbound-key '() "")
+ (expect (wsi-get-unbound-key "" '("abc" "123"))
:to-throw 'error)))
(describe "`with-simulated-input'"
- (it "should work for basic string input"
- (expect
- (with-simulated-input "hello RET"
- (read-string "Enter a string: "))
- :to-equal "hello"))
+ (describe "should work when KEYS"
+
+ (it "is a literal string"
+ (expect
+ (with-simulated-input "hello RET"
+ (read-string "Enter a string: "))
+ :to-equal "hello"))
+
+ (it "is a quoted list of literal strings"
+ (expect
+ (with-simulated-input '("hello" "RET")
+ (read-string "Enter a string: "))
+ :to-equal "hello"))
+
+ (it "is a quoted list of lisp forms"
+ (expect
+ (with-simulated-input '((insert "hello") (exit-minibuffer))
+ (read-string "Enter a string: "))
+ :to-equal "hello"))
+
+ (it "is a quoted list of strings and lisp forms"
+ (expect
+ (with-simulated-input '((insert "hello") "RET")
+ (read-string "Enter a string: "))
+ :to-equal "hello")
+ (expect
+ (with-simulated-input '("hello" (exit-minibuffer))
+ (read-string "Enter a string: "))
+ :to-equal "hello")
+ (expect
+ (with-simulated-input '("hello SPC" (insert "world") "RET")
+ (read-string "Enter a string: "))
+ :to-equal "hello world"))
+
+ (it "is a variable containing any of the above"
+ (cl-loop
+ for input in
+ '("hello RET"
+ ("hello" "RET")
+ ((insert "hello") (exit-minibuffer))
+ ((insert "hello") "RET")
+ ("hello" (exit-minibuffer)))
+ do (expect
+ (with-simulated-input input
+ (read-string "Enter a string: "))
+ :to-equal "hello")))
+
+ (it "is an arbitrary expression evaluating to any of the above"
+ (expect
+ (with-simulated-input (list "hello" "RET")
+ (read-string "Enter a string: "))
+ :to-equal "hello")
+ (expect
+ (let ((my-input "hello"))
+ (with-simulated-input (list '(insert my-input) "RET")
+ (read-string "Enter a string: ")))
+ :to-equal "hello")
+ (expect
+ (with-simulated-input (concat "hello" " " "RET")
+ (read-string "Enter a string: "))
+ :to-equal "hello")
+ (let ((my-key-sequence "hello")
+ (my-lisp-form '(insert " world")))
+ (expect
+ (with-simulated-input (list
+ my-key-sequence
+ my-lisp-form
+ "RET")
+ (read-string "Enter a string: "))
+ :to-equal "hello world")))
+ (it "is evaluated at run time in a lexical environment"
+ (let ((my-input "hello"))
+ (expect
+ (with-simulated-input `((insert ,my-input) "RET")
+ (read-string "Enter a string: "))
+ :to-equal "hello"))
+ (let ((greeting "hello")
+ (target "world"))
+ (expect
+ (with-simulated-input
+ (list greeting "SPC"
+ (list 'insert target)
+ "RET")
+ (read-string "Say hello: "))
+ :to-equal "hello world"))
+ (let ((my-lexical-var nil))
+ (with-simulated-input '("hello"
+ (setq my-lexical-var t)
+ "RET")
+ (read-string "Enter a string: "))
+ (expect my-lexical-var
+ :to-be-truthy)))
+
+ (it "is evaluated at run time in a non-lexical environment"
+ (let ((my-non-lexical-var nil))
+ (eval
+ '(with-simulated-input '("hello"
+ (setq my-non-lexical-var t)
+ "RET")
+ (read-string "Enter a string: "))
+ nil)
+ (expect my-non-lexical-var
+ :to-be-truthy))))
+
+ (describe "should correctly propagate errors"
+
+ (it "thrown directly from expressions in KEYS"
+ (expect
+ (with-simulated-input '("hello" (error "Throwing an error from KEYS")
"RET")
+ (read-string "Enter a string: "))
+ :to-throw))
+
+ (it "caused indirectly by the inputs in KEYS"
+ (expect
+ (with-simulated-input
+ "(error SPC \"Manually SPC throwing SPC an SPC error\") RET"
+ (command-execute 'eval-expression))
+ :to-throw))
+
+ (it "thrown by BODY"
+ (expect
+ (with-simulated-input
+ "hello RET"
+ (read-string "Enter a string: ")
+ (error "Throwing an error after reading input"))
+ :to-throw)
+ (expect
+ (with-simulated-input
+ "hello RET"
+ (error "Throwing an error before reading input")
+ (read-string "Enter a string: "))
+ :to-throw))
+
+ (it "from aborting via C-g in KEYS"
+ (expect
+ (condition-case nil
+ (with-simulated-input "C-g"
+ (read-string "Enter a string: "))
+ (quit 'caught-quit))
+ :to-be 'caught-quit)))
+
+ ;; TODO: Warn on no-op elements like this: any variable or
+ ;; non-string literal, or any expression known to involve only pure
+ ;; functions.
+ (it "should ignore the return value of expressions in KEYS"
+ (let ((desired-input "hello")
+ (undesired-input "goodbye"))
+ (expect
+ (with-simulated-input '((insert desired-input) undesired-input "RET")
+ (read-string "Enter a string: "))
+ :to-equal desired-input)))
(it "should throw an error if the input is incomplete"
(expect
- (with-simulated-input "hello"
+ (with-simulated-input "hello" ; No RET
(read-string "Enter a string: "))
:to-throw))
- (it "should allow the input to trigger errors"
+ (it "should discard any extra input after BODY has completed"
(expect
-
(with-simulated-input
- "(error SPC \"Manually SPC throwing SPC an SPC error\") RET"
- (command-execute 'eval-expression))
- :to-throw))
-
- (it "should ignore extra input after BODY has completed"
+ "hello RET M-x eval-expression (error SPC \"Manually SPC throwing SPC
an SPC error\") RET"
+ (read-string "Enter a string: "))
+ :to-equal "hello")
(expect
(with-simulated-input
- "hello RET M-x eval-expression (error SPC \"Manually SPC throwing SPC
an SPC error\") RET"
+ '("hello RET" (error "Throwing an error after BODY has completeld."))
(read-string "Enter a string: "))
:to-equal "hello"))
@@ -58,23 +203,6 @@
(read-string "Second word: ")))
:to-equal '("hello" "world")))
- (it "should allow aborting via C-g in KEYS"
- (expect
- (condition-case nil
- (with-simulated-input "C-g"
- (read-string "Enter a string: "))
- (quit 'caught-quit))
- :to-be 'caught-quit))
-
- ;; https://github.com/DarwinAwardWinner/with-simulated-input/issues/4
- (it "should work inside code that switches buffer (issue #4)"
- (let ((orig-current-buffer (current-buffer)))
- (with-temp-buffer
- (let ((temp-buffer (current-buffer)))
- (with-simulated-input "a" (read-char))
- (expect (current-buffer) :to-equal temp-buffer)
- (expect (current-buffer) :not :to-equal orig-current-buffer)))))
-
(describe "used with `completing-read'"
:var (completing-read-function)
@@ -106,76 +234,18 @@
(completing-read "Choose: " my-collection nil t))
:to-throw)))
- (describe "using lisp forms in KEYS argument of `with-simulated-input'"
-
- (it "should allow evaluating arbitrary lisp forms"
- (expect
- (with-simulated-input '("hello SPC" (insert "world") "RET")
- (read-string "Enter a string: "))
- :to-equal "hello world"))
-
- (it "should allow KEYS to be evaluated at run time"
- (let ((greeting "hello")
- (target "world"))
- (expect
- (with-simulated-input '((insert greeting) "SPC" (insert target) "RET")
- (read-string "Say hello: "))
- :to-equal "hello world")))
-
- (it "should allow a variable for KEYS"
- (let ((keys "hello RET"))
- (expect (with-simulated-input keys (read-string "Say hello: "))
- :to-equal "hello")))
-
- (it "should error for non-string variable KEYS"
- (let ((keys (lambda () (insert "X"))))
- (expect (with-simulated-input keys (read-string "Input: "))
- :to-throw)))
-
- (it "should allow lisp forms to throw errors"
- (expect
-
- (with-simulated-input '("hello SPC" (error "Throwing an error") "RET")
- (read-string "Enter a string: "))
- :to-throw))
-
- (it "should not interpret lisp forms once BODY has finished"
- (expect
- (with-simulated-input '("hello SPC world RET RET"
- (error "Should not reach this error"))
- (read-string "Enter a string: "))
- :to-equal "hello world"))
-
- (it "should evaluate lisp forms in the proper lexical environment"
- (let ((my-lexical-var nil))
- (with-simulated-input '("hello"
- (setq my-lexical-var t)
- "RET")
- (read-string "Enter a string: "))
- (expect my-lexical-var
- :to-be-truthy)))
-
- (it "should work in a non-lexical environment"
- (let ((my-non-lexical-var nil))
- (eval
- '(with-simulated-input '("hello"
- (setq my-non-lexical-var t)
- "RET")
- (read-string "Enter a string: "))
- nil)
- (expect my-non-lexical-var
- :to-be-truthy)))
-
- (it "should allow interpolation of variables into KEYS"
- (let ((my-key-sequence "hello")
- (my-lisp-form '(insert " world")))
- (expect
- (with-simulated-input
- '(my-key-sequence
- (eval my-lisp-form)
- "RET")
- (read-string "Enter a string: "))
- :to-equal "hello world")))))
+ (describe "should not reproduce past issues:"
+ ;; https://github.com/DarwinAwardWinner/with-simulated-input/issues/4
+ (it "Issue #4: simulating input should not switch buffers"
+ (let ((orig-current-buffer (current-buffer)))
+ (with-temp-buffer
+ (let ((temp-buffer (current-buffer)))
+ (with-simulated-input "a" (read-char))
+ (expect (current-buffer) :to-equal temp-buffer)
+ (expect (current-buffer) :not :to-equal orig-current-buffer)))))
+ (xit "Issue #6: `with-simulated-input' should work in byte-compiled code"
+ (expect (call-wsi-from-bytecomp-fun)
+ :not :to-throw))))
(defun time-equal-p (t1 t2)
"Return non-nil if T1 and T2 represent the same time.
@@ -252,6 +322,10 @@ Note that there are multiple ways to represent a time, so
(expect canary-idle-time :to-be-truthy)
(expect (time-equal-p canary-idle-time (seconds-to-time 1))))
+ (it "should not interfere with the normal operation of `current-idle-time'"
+ ;; Outside WSI, this will just return the normal value
+ (expect (current-idle-time) :not :to-throw))
+
(it "should actually wait the specified time when `actually-wait' is non-nil"
(spy-on 'sleep-for :and-call-through)
(run-with-idle-timer 0.01 nil 'idle-canary)
diff --git a/with-simulated-input.el b/with-simulated-input.el
index afa7863529..772656dd67 100644
--- a/with-simulated-input.el
+++ b/with-simulated-input.el
@@ -215,7 +215,8 @@ are the arguments given to it."
(when (time-less-p (seconds-to-time 0) wsi-simulated-idle-time)
wsi-simulated-idle-time)
(apply orig-fun args)))
-(advice-add 'current-idle-time :around 'current-idle-time@simulate-idle-time)
+(advice-add 'current-idle-time
+ :around #'current-idle-time@simulate-idle-time)
(cl-defun wsi-simulate-idle-time (&optional secs actually-wait)
"Run all idle timers with delay less than SECS.
@@ -283,6 +284,11 @@ add other idle timers."
(sleep-for (float-time (time-subtract stop-time
wsi-simulated-idle-time))))))
+(defun with-simulated-input-unload-function ()
+ "Unload the `with-simulated-input' library."
+ (advice-remove 'current-idle-time
+ #'current-idle-time@simulate-idle-time))
+
(provide 'with-simulated-input)
;;; with-simulated-input.el ends here