emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[nongnu] elpa/with-simulated-input 3525ed7dc5 095/134: Merge branch 'ble


From: ELPA Syncer
Subject: [nongnu] elpa/with-simulated-input 3525ed7dc5 095/134: Merge branch 'bleeding-edge' into rewrite-bleed
Date: Mon, 10 Jan 2022 23:00:09 -0500 (EST)

branch: elpa/with-simulated-input
commit 3525ed7dc591054e738d329d95059f8abeb5e7a4
Merge: ef9d5164ca 26fc928f42
Author: Ryan C. Thompson <rct@thompsonclan.org>
Commit: Ryan C. Thompson <rct@thompsonclan.org>

    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



reply via email to

[Prev in Thread] Current Thread [Next in Thread]