help-gnu-emacs
[Top][All Lists]
Advanced

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

Re: Compiled vs. interpreted ERT test


From: Stefan Monnier
Subject: Re: Compiled vs. interpreted ERT test
Date: Thu, 27 Feb 2020 22:16:53 -0500
User-agent: Gnus/5.13 (Gnus v5.13) Emacs/28.0.50 (gnu/linux)

>> I opened an issue on the package's Github page but the maintainer says he
>> doesn't know how to debug this.[2] So I'm coming here in the hopes someone
>> has an idea or a suggestion how to debug this.
> I haven't looked at the rest of the code, but the first thing I saw is:

Maybe the 100% untested patch below is a good starting point.


        Stefan


diff --git a/README.md b/README.md
index f3f95e7..e85ef05 100644
--- a/README.md
+++ b/README.md
@@ -31,7 +31,7 @@ enter "world" after entering "hello" via key sequence:
 
 ```elisp
 (with-simulated-input
-    '("hello SPC" (insert "world") "RET")
+    ("hello SPC" (insert "world") "RET")
   (read-string "Say hello: "))
 ```
 
@@ -47,7 +47,7 @@ will return `"hello world"`.
 (run-with-idle-timer 500 nil 'insert "world")
 (with-simulated-input
     ;; Type "hello ", then "wait" 501 seconds, then type "RET"
-    '("hello SPC" (wsi-simulate-idle-time 501) "RET")
+    ("hello SPC" (wsi-simulate-idle-time 501) "RET")
   (read-string "Enter a string: "))
 ```
 
diff --git a/with-simulated-input.el b/with-simulated-input.el
index 0f344f1..c44f2a3 100644
--- a/with-simulated-input.el
+++ b/with-simulated-input.el
@@ -12,17 +12,6 @@
 
 ;; This file is NOT part of GNU Emacs.
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Commentary:
-
-;; This package provides a single macro, `with-simulated-input', which
-;; evaluates one or more forms while simulating a sequence of input
-;; events for those forms to read. The result is the same as if you
-;; had evaluated the forms and then manually typed in the same input.
-;; This macro is useful for non-interactive testing of normally
-;; interactive commands and functions, such as `completing-read'.
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
 ;; This program is free software: you can redistribute it and/or modify
@@ -40,88 +29,18 @@
 ;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
-;;; Code:
-
-(require 'cl-lib)
-
-(cl-defun wsi-key-bound-p (key)
-  "Return non-nil if KEY is bound in any keymap.
-
-This function checks every keymap in `obarray' for a binding for
-KEY, and returns t if it finds and and nil otherwise. Note that
-this checks ALL keymaps, not just currently active ones."
-  (catch 'bound
-    (mapatoms
-     (lambda (sym)
-       (let ((keymap
-              (when (boundp sym)
-                (symbol-value sym))))
-         (when (keymapp keymap)
-           (let ((binding (lookup-key keymap (kbd key))))
-             (when binding
-               (throw 'bound t)))))))
-    (throw 'bound nil)))
-
-(cl-defun wsi-get-unbound-key
-    (&optional (modifiers '("C-M-A-s-H-" "C-M-A-s-" "C-M-A-H-"))
-               (keys "abcdefghijklmnopqrstuvwxyz0123456789"))
-  "Return a key binding that is not bound in any known keymap.
-
-This function will check every letter from a to z and every
-number from 0 through 9 with several combinations of multiple
-modifiers (i.e. control, meta, alt, super, hyper). For each such
-key combination, it will check for bindings in all known keymaps,
-and return the first combination for which no such bindings
-exist. Thus, it should be safe to bind this key in a new keymap
-without interfering with any existing keymap.
-
-Optional arguments MODIFIERS and KEYS can be used the change the
-search space. MODIFIERS is a list of strings representing
-modifier combinations, e.g.:
-
-    '(\"C-\" \"M-\" \"C-M-\")
-
-for control, meta, or both. KEYS is a string containing all keys
-to check.
-"
-  (declare (advertised-calling-convention (&optional modifiers keys) nil))
-  (when (stringp modifiers)
-    (setq modifiers (list modifiers)))
-  (when (listp keys)
-    (setq keys (apply #'concat keys)))
-  (cl-loop
-   named findkey
-   for modifier in modifiers
-   do (cl-loop
-       for char across keys
-       for bind = (concat modifier (string char))
-       when (not (wsi-key-bound-p bind))
-       do (cl-return-from findkey bind))
-   finally do (error "Could not find an unbound key with the specified 
modifiers")))
-
-(defmacro wsi-current-lexical-environment ()
-  "Return the current lexical environment.
-
-If `lexical-binding' is not enabled, return nil.
-
-This macro expands to a Lisp form that evaluates to the current
-lexical environment. It works by creating a closure and then
-extracting and returning its lexical environment.
+;;; Commentary:
 
-This can be used to manually construct closures in that
-environment."
-  `(let ((temp-closure (lambda () t)))
-     (when (eq (car temp-closure) 'closure)
-       (cadr temp-closure))))
+;; This package provides a single macro, `with-simulated-input', which
+;; evaluates one or more forms while simulating a sequence of input
+;; events for those forms to read. The result is the same as if you
+;; had evaluated the forms and then manually typed in the same input.
+;; This macro is useful for non-interactive testing of normally
+;; interactive commands and functions, such as `completing-read'.
 
-(defun wsi-make-closure (expr env)
-  "Construct a closure from EXPR and ENV.
+;;; Code:
 
-Returns a zero-argument function that, when called, evaluates
-EXPR in lexical environment ENV and returns the result."
-  (if env
-      `(closure ,env () ,expr)
-    `(lambda () ,expr)))
+(require 'cl-lib)
 
 (defconst wsi--canary-sym (cl-gensym "wsi-canary-")
   "A unique symbol.")
@@ -139,7 +58,7 @@ keys after initiating evaluation of BODY.
 KEYS should be a string representing a sequence of key presses,
 in the format understood by `kbd'. In the most common case of
 typing in some text and pressing RET, KEYS would be something
-like `\"hello RET\"'. Note that spaced must be indicated
+like `\"hello RET\"'. Note that spaces must be indicated
 explicitly using `SPC', e.g. `\"hello SPC world RET\"'.
 
 KEYS can also be a list. In this case, each element should either
@@ -161,86 +80,74 @@ are propagated normally.
 
 The return value is the last form in BODY, as if it was wrapped
 in `progn'."
-  (declare (indent 1))
-  `(cl-letf*
-       ((lexenv (wsi-current-lexical-environment))
-        (correct-current-buffer (current-buffer))
-        (next-action-key (wsi-get-unbound-key))
-        (result wsi--canary-sym)
-        (thrown-error nil)
-        (body-form
-         '(throw 'wsi-body-finished (progn ,@body)))
-        (end-of-actions-form
-         (list 'throw
-               '(quote wsi-body-finished)
-               (list 'quote wsi--canary-sym)))
-        ;; Ensure KEYS is a list, and put the body form as the first
-        ;; item and `C-g' as the last item
-        (keylist ,keys)
-        (keylist (if (listp keylist)
-                     keylist
-                   (list keylist)))
-        ;; Build the full action list, which includes everything in
-        ;; KEYS, as well as some additional setup beforehand and
-        ;; cleanup afterward.
-        (action-list
-         (nconc
-          (list
-           ;; First we switch back to the correct buffer (since
-           ;; `execute-kbd-macro' switches to the wrong one).
-           (list 'switch-to-buffer correct-current-buffer)
-           ;; Then we run the body form
-           body-form)
-          ;; Then we run each of the actions specified in KEYS
+  (declare (indent 1)) ;; Add `debug' spec?
+  ;; Old usage convention where KEYS was evaluated at run time.
+  (when (eq 'quote (car-safe keys)) (setq keys (cadr keys)))
+  ;; Ensure KEYS is a list.
+  (unless (listp keys) (setq keys (list keys)))
+  `(with--simulated-input
+       ;; Wrap each action in a lexical closure so it can refer to
+       ;; variables from the caller.
+       (list ,@(mapcar (lambda (x) (if (stringp x) x `(lambda () ,x))) keys))
+     (lambda () ,@body)))
+
+(defun with--simulated-input (keys body-fun)
+  (let* ((current-buffer (current-buffer))
+         (next-action-key 'wsi--next-action-key)
+         (result wsi--canary-sym)
+         (thrown-error nil)
+         (real-body-fun
+          (lambda ()
+            (with-current-buffer current-buffer
+              (throw 'wsi-body-finished (funcall body-fun)))))
+         (end-of-actions-fun
+          (lambda () (throw 'wsi-body-finished wsi--canary-sym)))
+         ;; Build the full action list, which includes everything in
+         ;; KEYS, as well as some additional setup beforehand and
+         ;; cleanup afterward.
+         (action-list
+          `(,real-body-fun
+            ;; Then we run each of the actions specified in KEYS
+            ,@(cl-loop
+               for action in keys
+               if (not (stringp action))
+               collect action)
+            ;; Finally we throw the canary if we read past the end of
+            ;; the input.
+            ,end-of-actions-fun))
+         ;; Replace non-strings with `next-action-key' and concat
+         ;; everything together
+         (full-key-sequence
           (cl-loop
-           for action in keylist
-           if (not (stringp action))
-           collect action)
-          ;; Finally we throw the canary if we read past the end of
-          ;; the input.
-          (list end-of-actions-form)))
-        ;; Wrap each action in a lexical closure so it can refer to
-        ;; variables from the caller.
-        (action-closures
-         (cl-loop
-          for action in action-list
-          collect (wsi-make-closure action lexenv)))
-        ;; Replace non-strings with `next-action-key' and concat
-        ;; everything together
-        (full-key-sequence
-         (cl-loop
-          for action in keylist
-          if (stringp action)
-          collect action into key-sequence-list
-          else
-          collect next-action-key into key-sequence-list
-          finally return
-          ;; Prepend and append `next-action-key' as appropriate to
-          ;; switch buffer, run body, and throw canary.
-          (concat
-           ;; Switch to correct buffer
-           next-action-key " "
-           ;; Start executing body
-           next-action-key " "
-           ;; Execute the actual key sequence
-           (mapconcat #'identity key-sequence-list " ")
-           ;; Throw the canary if BODY reads past the provided input
-           " " next-action-key)))
-        ;; Define the next action command with lexical scope so it can
-        ;; access `action-closures'.
-        ((symbol-function 'wsi-run-next-action)
-         (lambda ()
-           (interactive)
-           (condition-case err
-               (if action-closures
-                   (let ((next-action (pop action-closures)))
-                     (funcall next-action))
-                 (error "`with-simulated-input' reached end of action list 
without returning"))
-             (error (throw 'wsi-threw-error err)))))
-        ;; Set up the temporary keymap
-        (action-map (make-sparse-keymap)))
+           for action in keys
+           
+           collect (if (stringp action) action next-action-key)
+           into key-sequence-list
+           finally return
+           ;; Prepend and append `next-action-key' as appropriate to
+           ;; switch buffer, run body, and throw canary.
+           (concat
+            ;; Start executing body
+            next-action-key " "
+            ;; Execute the actual key sequence
+            (mapconcat #'identity key-sequence-list " ")
+            ;; Throw the canary if BODY reads past the provided input
+            " " next-action-key)))
+         ;; Define the next action command with lexical scope so it can
+         ;; access `action-closures'.
+         (wsi-run-next-action
+          (lambda ()
+            (interactive)
+            (condition-case err
+                (if action-list
+                    (let ((next-action (pop action-list)))
+                      (funcall next-action))
+                  (error "`with-simulated-input' reached end of action list 
without returning"))
+              (error (throw 'wsi-threw-error err)))))
+         ;; Set up the temporary keymap
+         (action-map (make-sparse-keymap)))
      ;; Finish setting up the keymap for the temp command
-     (define-key action-map (kbd next-action-key) 'wsi-run-next-action)
+     (define-key action-map (kbd next-action-key) wsi-run-next-action)
      (setq
       thrown-error
       (catch 'wsi-threw-error




reply via email to

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