[nongnu] elpa/with-simulated-input addb2a0711 122/134: Improve KEYS validation logic and error messages

[ELPA Syncer]

branch: elpa/with-simulated-input
commit addb2a071158df8c15981adaf5960f0915f8cc1d
Author: Ryan C. Thompson <rct@thompsonclan.org>
Commit: Ryan C. Thompson <rct@thompsonclan.org>

    Improve KEYS validation logic and error messages
    
    Some error messages should now better point to the root cause.
    
    In addition, the test suite now controls evaluation so as to produce
    all errors and warnings at runtime instead of load time.
---
 tests/test-with-simulated-input.el | 103 +++++++++++++++++++------------------
 with-simulated-input.el            |  50 ++++++++++++------
 2 files changed, 87 insertions(+), 66 deletions(-)

diff --git a/tests/test-with-simulated-input.el 
b/tests/test-with-simulated-input.el
index 79242da374..8d25db21bd 100644
--- a/tests/test-with-simulated-input.el
+++ b/tests/test-with-simulated-input.el
@@ -9,6 +9,10 @@
 (defvar my-non-lexical-var)
 
 (defun call-wsi-from-bytecomp-fun ()
+  "This function calls `with-simulated-input' and is byte-compiled.
+
+It will only work if `with-simulated-input' works when called
+from byte-compiled code."
   (with-simulated-input "hello SPC world RET"
     (read-string "Say hello: ")))
 (byte-compile 'call-wsi-from-bytecomp-fun)
@@ -83,16 +87,14 @@ during macro expansion will be caught as well."
          (read-char "Choose your character: "))
        :to-equal ?y))
 
-    ;; Deprecated
-    (it "is a quoted list of literal strings"
+    (it "is a quoted list of literal strings (deprecated)"
       (expect-warning
        (expect
         (with-simulated-input '("hello" "RET")
           (read-string "Enter a string: "))
         :to-equal "hello")))
 
-    ;; Deprecated
-    (it "is a quoted list of characters"
+    (it "is a quoted list of characters (deprecated)"
       (expect-warning
        (expect
         ;; 10 is RET
@@ -100,16 +102,14 @@ during macro expansion will be caught as well."
           (read-string "Enter a string: "))
         :to-equal "hello")))
 
-    ;; Deprecated
-    (it "is a quoted list of lisp forms"
+    (it "is a quoted list of lisp forms (deprecated)"
       (expect-warning
        (expect
         (with-simulated-input '((insert "hello") (exit-minibuffer))
           (read-string "Enter a string: "))
         :to-equal "hello")))
 
-    ;; Deprecated
-    (it "is a quoted list of strings, characters, and lisp forms"
+    (it "is a quoted list of strings, characters, and lisp forms (deprecated)"
       (expect-warning
        (expect
         (with-simulated-input '((insert "hello") "RET")
@@ -165,7 +165,7 @@ during macro expansion will be caught as well."
          (read-string "Enter a string: "))
        :to-equal "hello world")
       (expect
-       (with-simulated-input '("hello SPC" (insert "wor") ?l ?d 10)
+       (with-simulated-input ("hello SPC" (insert "wor") ?l ?d 10)
          (read-string "Enter a string: "))
        :to-equal "hello world"))
 
@@ -184,8 +184,7 @@ during macro expansion will be caught as well."
            :to-equal "hello")))
 
     ;; This syntax is not known to be used in any real code.
-    ;; Deprecated.
-    (it "is an arbitrary expression evaluating to any of the above"
+    (it "is an arbitrary expression evaluating to any of the above 
(deprecated)"
       (expect-warning
        (expect
         (with-simulated-input (list "hello" "RET")
@@ -237,20 +236,22 @@ during macro expansion will be caught as well."
 
     ;; This syntax is not known to be used in any real code
     (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"))
+      (expect-warning
+       (let ((my-input "hello"))
+         (expect
+          (with-simulated-input `((insert ,my-input) "RET")
+            (read-string "Enter a string: "))
+          :to-equal "hello")))
+      (expect-warning
+       (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)
@@ -274,12 +275,14 @@ during macro expansion will be caught as well."
 
     (it "is an invalid literal expression"
       (expect
-       (with-simulated-input :invalid-input
-         (read-string "Enter a string: "))
+       ;; Eval prevents eager macro-expansion, since this macro
+       ;; expansion throws an error.
+       (eval '(with-simulated-input :invalid-input
+                (read-string "Enter a string: ")))
        :to-throw 'error)
       (expect
-       (with-simulated-input ["vectors" "are" "invalid"]
-         (read-string "Enter a string: "))
+       (eval '(with-simulated-input ["vectors" "are" "invalid"]
+                (read-string "Enter a string: ")))
        :to-throw 'error))
 
     (it "is a variable with an invalid value"
@@ -362,14 +365,15 @@ during macro expansion will be caught as well."
      (with-simulated-input ()
        (read-string "Enter a string: "))
      :to-throw 'error)
-    (expect
-     (with-simulated-input '()
-       (read-string "Enter a string: "))
-     :to-throw 'error)
-    (expect
-     (with-simulated-input (nil)
-       (read-string "Enter a string: "))
-     :to-throw 'error)
+    (expect-warning
+     (expect
+      (with-simulated-input '()
+        (read-string "Enter a string: "))
+      :to-throw 'error)
+     (expect
+      (with-simulated-input (nil)
+        (read-string "Enter a string: "))
+      :to-throw 'error))
     (let ((my-input nil))
       (expect
        (with-simulated-input my-input
@@ -385,14 +389,15 @@ during macro expansion will be caught as well."
      (with-simulated-input ()
        (+ 1 2))
      :not :to-throw)
-    (expect
-     (with-simulated-input '()
-       (+ 1 2))
-     :not :to-throw)
-    (expect
-     (with-simulated-input '(nil)
-       (+ 1 2))
-     :not :to-throw)
+    (expect-warning
+     (expect
+      (with-simulated-input '()
+        (+ 1 2))
+      :not :to-throw)
+     (expect
+      (with-simulated-input '(nil)
+        (+ 1 2))
+      :not :to-throw))
     (let ((my-input nil))
       (expect
        (with-simulated-input my-input
@@ -407,7 +412,7 @@ during macro expansion will be caught as well."
      :to-equal "hello")
     (expect
      (with-simulated-input
-         '("hello RET" (error "Throwing an error after BODY has completeld."))
+         ("hello RET" (error "Throwing an error after BODY has completed."))
        (read-string "Enter a string: "))
      :to-equal "hello"))
 
@@ -572,9 +577,9 @@ Note that there are multiple ways to represent a time, so
       (run-with-idle-timer 500 nil 'insert "world")
       (expect
        (with-simulated-input
-           '("hello SPC"
-             (wsi-simulate-idle-time 501)
-             "RET")
+           ("hello SPC"
+            (wsi-simulate-idle-time 501)
+            "RET")
          (read-string "Enter a string: "))
        :to-equal "hello world"))))
 
diff --git a/with-simulated-input.el b/with-simulated-input.el
index 1e4db4ccb0..94295bd15e 100644
--- a/with-simulated-input.el
+++ b/with-simulated-input.el
@@ -226,15 +226,17 @@ generated for each one unless QUIET is non-nil."
       ;; type of pure expression
       (concat
        "Non-string forms in KEYS are evaluated for side effects only. "
-       (cond
-        ((functionp key)
-         "Functions in KEYS have no effect unless they are called.")
-        ((wsi--looks-constant-p key)
-         "Non-string constants in KEYS have no effect.")
-        ((symbolp key)
-         "Variables in KEYS have no effect.")
-        (t
-         "Pure expressions in KEYS have no effect.")))))
+       (format
+        (cond
+         ((functionp key)
+          "Functions in KEYS have no effect unless they are called: %S")
+         ((wsi--looks-constant-p key)
+          "Non-string constants in KEYS have no effect: %S")
+         ((symbolp key)
+          "Variables in KEYS have no effect: %S")
+         (t
+          "Pure expressions in KEYS have no effect: %S"))
+        key))))
    ;; Anything else might be an expression with side effects.
    else collect key))
 
@@ -309,7 +311,6 @@ in a future release.)"
                 ([&or functionp macrop] &rest form) ; arbitrary lisp function 
call
                 ]
            body)))
-  ;; TODO Support integers (i.e. single characters) in KEYS
   (cond
    ;; This case applies when BODY consists of only constant
    ;; expressions (or no expressions at all). Since all the
@@ -346,6 +347,9 @@ in a future release.)"
    ;; values are currently supported for backwards-compatibility, but
    ;; are deprecated.)
    ((and keys (symbolp keys))
+    (when (keywordp keys)
+      (error "KEYS must be a string, character, or list, not keyword: %s"
+             keys))
     `(cond
       ((null ,keys)
        (with-simulated-input-1
@@ -376,7 +380,7 @@ in a future release.)"
          else if (characterp key) collect (key-description (string key))
          else if key collect `(lambda () ,key))))
       (t
-       (error "KEYS must be a string or list, not %s: %s = %S"
+       (error "KEYS must be a string, character, or list, not %s: %s = %S"
               (type-of ,keys) ',keys ,keys))))
    ;; If KEYS is a list whose first element is not `quote', then it is
    ;; a function call, whose return value will be used as the value of
@@ -387,7 +391,9 @@ in a future release.)"
              (macrop (car keys))))
     (display-warning
      'with-simulated-input
-     "Passing a function call as KEYS is deprecated and will not be supported 
in future releases.")
+     (format
+      "Passing a function call as KEYS is deprecated and will not be supported 
in future releases: %S"
+      keys))
     (let ((evaluated-keys-sym (make-symbol "evaluated-keys")))
       `(let ((,evaluated-keys-sym (,@keys)))
          (pcase ,evaluated-keys-sym
@@ -410,13 +416,23 @@ in a future release.)"
    ;; un-quoted list of strings and list expressions to execute as
    ;; input.
    (t
+    ;; Unwrap a quoted expression
     (pcase keys
       (`(quote ,x)
-       (prog1 (setq keys x)
-         (display-warning
-          'with-simulated-input
-          "Passing a quoted list as KEYS is deprecated and will not be 
supported in future releases.")))
-      ((guard (not (listp keys))) (cl-callf list keys)))
+       (display-warning
+        'with-simulated-input
+        (format
+         "Passing a quoted list as KEYS is deprecated and will not be 
supported in future releases: %S" keys))
+       (setq keys x)))
+    ;; Ensure KEYS has the correct type, and convert a non-list keys
+    ;; into a 1-element list.
+    (unless (listp keys)
+      (if (or (null keys)
+              (stringp keys)
+              (characterp keys))
+          (setq keys (list keys))
+        (error "KEYS must be a string, character, or list, not %s: KEYS = %S"
+               (type-of keys) keys)))
     `(with-simulated-input-1
       (lambda ()
         ,@body)