1122 lines
48 KiB
EmacsLisp
1122 lines
48 KiB
EmacsLisp
;;; edebug-tests.el --- Edebug test suite -*- lexical-binding:t -*-
|
|
|
|
;; Copyright (C) 2017-2024 Free Software Foundation, Inc.
|
|
|
|
;; Author: Gemini Lasswell
|
|
|
|
;; This file is part of GNU Emacs.
|
|
|
|
;; GNU Emacs is free software: you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
;; (at your option) any later version.
|
|
|
|
;; GNU Emacs is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
|
|
|
;;; Commentary:
|
|
|
|
;; These tests focus on Edebug's user interface for setting
|
|
;; breakpoints, stepping through and tracing code, and evaluating
|
|
;; values used by the code. In addition there are some tests of
|
|
;; Edebug's reader. There are large parts of Edebug's functionality
|
|
;; not covered by these tests, including coverage testing, macro
|
|
;; specifications, and the eval list buffer.
|
|
|
|
;;; Code:
|
|
|
|
(require 'cl-lib)
|
|
(require 'ert)
|
|
(require 'ert-x)
|
|
(require 'edebug)
|
|
(require 'kmacro)
|
|
|
|
(defvar edebug-tests-temp-file nil
|
|
"Name of temp file containing sample code stripped of stop point symbols.")
|
|
(defvar edebug-tests-stop-points nil
|
|
"An alist of alists mapping function symbol -> stop point name -> marker.
|
|
Used by the tests to refer to locations in `edebug-tests-temp-file'.")
|
|
(defvar edebug-tests-messages nil
|
|
"Messages collected during execution of the current test.")
|
|
|
|
(defvar edebug-tests-@-result 'no-result
|
|
"Return value of `edebug-tests-func', or no-result if there isn't one yet.")
|
|
|
|
(defvar edebug-tests-failure-in-post-command nil
|
|
"An error trapped in `edebug-tests-post-command'.
|
|
Since `should' failures which happen inside `post-command-hook' will
|
|
be trapped by the command loop, this preserves them until we get
|
|
back to the top level.")
|
|
|
|
(defvar-keymap edebug-tests-keymap
|
|
:doc "Keys used by the keyboard macros in Edebug's tests."
|
|
"@" 'edebug-tests-call-instrumented-func
|
|
"C-u" 'universal-argument
|
|
"C-p" 'previous-line
|
|
"C-n" 'next-line
|
|
"C-b" 'backward-char
|
|
"C-a" 'move-beginning-of-line
|
|
"C-e" 'move-end-of-line
|
|
"C-k" 'kill-line
|
|
"M-x" 'execute-extended-command
|
|
"C-M-x" 'eval-defun
|
|
"C-x X b" 'edebug-set-breakpoint
|
|
"C-x X w" 'edebug-where)
|
|
|
|
;;; Macros for defining tests:
|
|
|
|
(defmacro edebug-tests-with-default-config (&rest body)
|
|
"Create a consistent environment for an Edebug test BODY to run in."
|
|
(declare (debug (body)))
|
|
`(cl-letf* (
|
|
;; These defcustoms are set to their original value.
|
|
(edebug-setup-hook nil)
|
|
(edebug-all-defs nil)
|
|
(edebug-all-forms nil)
|
|
(edebug-eval-macro-args nil)
|
|
(edebug-save-windows t)
|
|
(edebug-save-displayed-buffer-points nil)
|
|
(edebug-initial-mode 'step)
|
|
(edebug-trace nil)
|
|
(edebug-test-coverage nil)
|
|
(edebug-print-length 50)
|
|
(edebug-print-level 50)
|
|
(edebug-print-circle t)
|
|
(edebug-unwrap-results nil)
|
|
(edebug-on-error t)
|
|
(edebug-on-quit t)
|
|
(edebug-global-break-condition nil)
|
|
(edebug-sit-for-seconds 1)
|
|
|
|
;; sit-on interferes with keyboard macros.
|
|
(edebug-sit-on-break nil)
|
|
(edebug-continue-kbd-macro t)
|
|
|
|
;; don't print backtraces, otherwise error messages don't match
|
|
(backtrace-on-error-noninteractive nil))
|
|
,@body))
|
|
|
|
(defmacro edebug-tests-with-normal-env (&rest body)
|
|
"Set up the environment for an Edebug test BODY, run it, and clean up."
|
|
(declare (debug (body)))
|
|
`(edebug-tests-with-default-config
|
|
(ert-with-temp-file edebug-tests-temp-file
|
|
:suffix ".el"
|
|
(let ((edebug-tests-failure-in-post-command nil)
|
|
(find-file-suppress-same-file-warnings t))
|
|
(edebug-tests-setup-code-file edebug-tests-temp-file)
|
|
(ert-with-message-capture
|
|
edebug-tests-messages
|
|
(unwind-protect
|
|
(with-current-buffer (find-file edebug-tests-temp-file)
|
|
(read-only-mode)
|
|
(setq lexical-binding t)
|
|
(syntax-ppss)
|
|
(eval-buffer)
|
|
,@body
|
|
(when edebug-tests-failure-in-post-command
|
|
(signal (car edebug-tests-failure-in-post-command)
|
|
(cdr edebug-tests-failure-in-post-command))))
|
|
(unload-feature 'edebug-test-code)
|
|
(with-current-buffer (find-file-noselect edebug-tests-temp-file)
|
|
(set-buffer-modified-p nil))
|
|
(ignore-errors (kill-buffer (find-file-noselect
|
|
edebug-tests-temp-file)))))))))
|
|
|
|
;; The following macro and its support functions implement an extension
|
|
;; to keyboard macros to allow interleaving of keyboard macro
|
|
;; events with evaluation of Lisp expressions. The Lisp expressions
|
|
;; are called from within `post-command-hook', which is a strategy
|
|
;; inspired by `kmacro-step-edit-macro'.
|
|
|
|
;; Some of the details necessary to get this to work with Edebug are:
|
|
;; -- ERT's `should' macros raise errors, and errors within
|
|
;; `post-command-hook' are trapped by the command loop. The
|
|
;; workaround is to trap and save an error inside the hook
|
|
;; function and reraise it after the macro exits.
|
|
;; -- `edebug-continue-kbd-macro' must be non-nil.
|
|
;; -- Edebug calls `exit-recursive-edit' which turns off keyboard
|
|
;; macro execution. Solved with an advice wrapper for
|
|
;; `exit-recursive-edit' which preserves the keyboard macro state.
|
|
|
|
(defmacro edebug-tests-run-kbd-macro (&rest macro)
|
|
"Run a MACRO consisting of both keystrokes and test assertions.
|
|
MACRO should be a list, where each item is either a keyboard
|
|
macro segment (in string or vector form) or a Lisp expression.
|
|
Convert the macro segments into keyboard macros and execute them.
|
|
After the execution of the last event of each segment, evaluate
|
|
the Lisp expressions following the segment."
|
|
(let ((prepared (edebug-tests-prepare-macro macro)))
|
|
`(edebug-tests-run-macro ,@prepared)))
|
|
|
|
;; Make support functions for edebug-tests-run-kbd-macro
|
|
;; available at compile time.
|
|
(eval-and-compile
|
|
(defun edebug-tests-prepare-macro (macro)
|
|
"Prepare a MACRO for execution.
|
|
MACRO should be a list containing strings, vectors, and Lisp
|
|
forms. Convert the strings and vectors to keyboard macros in
|
|
vector representation and concatenate them to make a single
|
|
keyboard macro. Also build a list of the same length as the
|
|
number of events in the keyboard macro. Each item in that list
|
|
will contain the code to evaluate after the corresponding event
|
|
in the keyboard macro, either nil or a thunk built from the forms
|
|
in the original list. Return a list containing the keyboard
|
|
macro as the first item, followed by the list of thunks and/or
|
|
nils."
|
|
(cl-loop
|
|
for item = (pop macro)
|
|
while item
|
|
for segment = (read-kbd-macro item)
|
|
for thunk = (edebug-tests-wrap-thunk
|
|
(cl-loop
|
|
for form in macro
|
|
until (or (stringp form) (vectorp form))
|
|
collect form
|
|
do (pop macro)))
|
|
vconcat segment into segments
|
|
append (edebug-tests-pad-thunk-list (length segment) thunk)
|
|
into thunk-list
|
|
|
|
finally return (cons segments thunk-list)))
|
|
|
|
(defun edebug-tests-wrap-thunk (body)
|
|
"If BODY is non-nil, wrap it with a lambda form."
|
|
(when body
|
|
`(lambda () ,@body)))
|
|
|
|
(defun edebug-tests-pad-thunk-list (length thunk)
|
|
"Return a list with LENGTH elements with THUNK in the last position.
|
|
All other elements will be nil."
|
|
(let ((thunk-seg (make-list length nil)))
|
|
(setf (car (last thunk-seg)) thunk)
|
|
thunk-seg)))
|
|
|
|
;;; Support for test execution:
|
|
|
|
(defvar edebug-tests-thunks nil
|
|
"List containing thunks to run after each command in a keyboard macro.")
|
|
(defvar edebug-tests-kbd-macro-index nil
|
|
"Index into `edebug-tests-run-kbd-macro's current keyboard macro.")
|
|
|
|
(defun edebug-tests-run-macro (kbdmac &rest thunks)
|
|
"Run a keyboard macro and execute a thunk after each command in it.
|
|
KBDMAC should be a vector of events and THUNKS a list of the
|
|
same length containing thunks and/or nils. Run the macro, and
|
|
after the execution of every command in the macro (which may not
|
|
be the same as every keystroke) execute the thunk at the same
|
|
index."
|
|
(let* ((edebug-tests-thunks thunks)
|
|
(edebug-tests-kbd-macro-index 0)
|
|
(find-file-suppress-same-file-warnings t)
|
|
saved-local-map)
|
|
(with-current-buffer (find-file-noselect edebug-tests-temp-file)
|
|
(setq saved-local-map overriding-local-map)
|
|
(setq overriding-local-map edebug-tests-keymap)
|
|
(add-hook 'post-command-hook #'edebug-tests-post-command))
|
|
(advice-add 'exit-recursive-edit
|
|
:around #'edebug-tests-preserve-keyboard-macro-state)
|
|
(unwind-protect
|
|
(kmacro-call-macro nil nil nil kbdmac)
|
|
(advice-remove 'exit-recursive-edit
|
|
#'edebug-tests-preserve-keyboard-macro-state)
|
|
(with-current-buffer (find-file-noselect edebug-tests-temp-file)
|
|
(setq overriding-local-map saved-local-map)
|
|
(remove-hook 'post-command-hook #'edebug-tests-post-command)))))
|
|
|
|
(defun edebug-tests-preserve-keyboard-macro-state (orig &rest args)
|
|
"Call ORIG with ARGS preserving the value of `executing-kbd-macro'.
|
|
Useful to prevent `exit-recursive-edit' from stopping the current
|
|
keyboard macro."
|
|
(let ((executing-kbd-macro executing-kbd-macro))
|
|
(apply orig args)))
|
|
|
|
(defun edebug-tests-post-command ()
|
|
"Run the thunk from `edebug-tests-thunks' matching the keyboard macro index."
|
|
(when (and edebug-tests-kbd-macro-index
|
|
(> executing-kbd-macro-index edebug-tests-kbd-macro-index))
|
|
(let ((thunk (nth (1- executing-kbd-macro-index) edebug-tests-thunks)))
|
|
(when thunk
|
|
(condition-case err
|
|
(funcall thunk)
|
|
(error
|
|
(setq edebug-tests-failure-in-post-command err)
|
|
(signal (car err) (cdr err)))))
|
|
(setq edebug-tests-kbd-macro-index executing-kbd-macro-index))))
|
|
|
|
(defvar edebug-tests-func nil
|
|
"Instrumented function used to launch Edebug.")
|
|
(defvar edebug-tests-args nil
|
|
"Arguments for `edebug-tests-func'.")
|
|
|
|
(defun edebug-tests-setup-@ (def-name args edebug-it)
|
|
"Set up the binding for @ in `edebug-tests-keymap'.
|
|
Find a definition for DEF-NAME in the current buffer and evaluate it.
|
|
Set globals so that `edebug-tests-call-instrumented-func' which
|
|
is bound to @ for edebug-tests' keyboard macros will call it with
|
|
ARGS. EDEBUG-IT is passed through to `eval-defun'."
|
|
(edebug-tests-locate-def def-name)
|
|
(eval-defun edebug-it)
|
|
(let* ((full-name (concat "edebug-test-code-" def-name))
|
|
(sym (intern-soft full-name)))
|
|
(should (and sym (fboundp sym)))
|
|
(setq edebug-tests-func sym
|
|
edebug-tests-args args)
|
|
(setq edebug-tests-@-result 'no-result)))
|
|
|
|
(defun edebug-tests-call-instrumented-func ()
|
|
"Call `edebug-tests-func' with `edebug-tests-args' and save the results."
|
|
(interactive)
|
|
(let ((result (apply edebug-tests-func edebug-tests-args)))
|
|
(should (eq edebug-tests-@-result 'no-result))
|
|
(setq edebug-tests-@-result result)))
|
|
|
|
(defun edebug-tests-should-be-at (def-name point-name)
|
|
"Require that point be at the location in DEF-NAME named POINT-NAME.
|
|
DEF-NAME should be the suffix of a definition in the code samples
|
|
file (the part after \"edebug-tests\")."
|
|
(let ((stop-point (edebug-tests-get-stop-point def-name point-name)))
|
|
(should (eq (current-buffer) (find-file-noselect edebug-tests-temp-file)))
|
|
(should (eql (point) stop-point))))
|
|
|
|
(defun edebug-tests-get-stop-point (def-name point-name)
|
|
"Return the position in DEF-NAME of the stop point named POINT-NAME.
|
|
DEF-NAME should be the suffix of a definition in the code samples
|
|
file (the part after \"edebug-tests\")."
|
|
(let* ((full-name (concat "edebug-test-code-" def-name))(stop-point
|
|
(cdr (assoc point-name
|
|
(cdr (assoc full-name edebug-tests-stop-points))))))
|
|
(unless stop-point
|
|
(ert-fail (format "%s not found in %s" point-name full-name)))
|
|
stop-point))
|
|
|
|
(defun edebug-tests-should-match-result-in-messages (value)
|
|
"Require that VALUE (a string) match an Edebug result in *Messages*.
|
|
Then clear edebug-tests' saved messages."
|
|
(should (string-match-p (concat "Result: " (regexp-quote value) "$")
|
|
edebug-tests-messages))
|
|
(setq edebug-tests-messages ""))
|
|
|
|
(defun edebug-tests-locate-def (def-name)
|
|
"Search for a definition of DEF-NAME from the start of the current buffer.
|
|
Place point at the end of DEF-NAME in the buffer."
|
|
(goto-char (point-min))
|
|
(re-search-forward (concat "def\\S-+ edebug-test-code-" def-name)))
|
|
|
|
(defconst edebug-tests-start-of-next-def-regexp "^(\\S-*def\\S-+ \\(\\S-+\\)"
|
|
"Regexp used to match the start of a definition.")
|
|
(defconst edebug-tests-stop-point-regexp "!\\(\\S-+?\\)!"
|
|
"Regexp used to match a stop point annotation in the sample code.")
|
|
|
|
;;; Set up buffer containing code samples:
|
|
|
|
(defmacro edebug-tests-deduplicate (name names-and-numbers)
|
|
"Return a unique variation on NAME.
|
|
NAME should be a string and NAMES-AND-NUMBERS an alist which can
|
|
be used by this macro to retain state. If NAME for example is
|
|
\"symbol\" then the first and subsequent uses of this macro will
|
|
evaluate to \"symbol\", \"symbol-1\", \"symbol-2\", etc."
|
|
(let ((g-name (gensym))
|
|
(g-duplicate (gensym)))
|
|
`(let* ((,g-name ,name)
|
|
(,g-duplicate (assoc ,g-name ,names-and-numbers)))
|
|
(if (null ,g-duplicate)
|
|
(progn
|
|
(push (cons ,g-name 0) ,names-and-numbers)
|
|
,g-name)
|
|
(cl-incf (cdr ,g-duplicate))
|
|
(format "%s-%s" ,g-name (cdr ,g-duplicate))))))
|
|
|
|
(defun edebug-tests-setup-code-file (tmpfile)
|
|
"Extract stop points and loadable code from the sample code file.
|
|
Write the loadable code to a buffer for TMPFILE, and set
|
|
`edebug-tests-stop-points' to a map from defined symbols to stop
|
|
point names to positions in the file."
|
|
(with-current-buffer (find-file-noselect (ert-resource-file "edebug-test-code.el"))
|
|
(let ((marked-up-code (buffer-string)))
|
|
(with-temp-file tmpfile
|
|
(insert marked-up-code))))
|
|
|
|
(with-current-buffer (find-file-noselect tmpfile)
|
|
(let ((stop-points
|
|
;; Delete all the !name! annotations from the code, but remember
|
|
;; their names and where they were in an alist.
|
|
(cl-loop
|
|
initially (goto-char (point-min))
|
|
while (re-search-forward edebug-tests-stop-point-regexp nil t)
|
|
for name = (match-string-no-properties 1)
|
|
do (replace-match "")
|
|
collect (cons name (point))))
|
|
names-and-numbers)
|
|
|
|
;; Now build an alist mapping definition names to annotation
|
|
;; names and positions.
|
|
;; If duplicate symbols exist in the file, enter them in the
|
|
;; alist as symbol, symbol-1, symbol-2 etc.
|
|
(setq edebug-tests-stop-points
|
|
(cl-loop
|
|
initially (goto-char (point-min))
|
|
while (re-search-forward edebug-tests-start-of-next-def-regexp
|
|
nil t)
|
|
for name =
|
|
(edebug-tests-deduplicate (match-string-no-properties 1)
|
|
names-and-numbers)
|
|
for end-of-def =
|
|
(save-match-data
|
|
(save-excursion
|
|
(re-search-forward edebug-tests-start-of-next-def-regexp
|
|
nil 0)
|
|
(point)))
|
|
collect (cons name
|
|
(cl-loop
|
|
while (and stop-points
|
|
(< (cdar stop-points) end-of-def))
|
|
collect (pop stop-points))))))))
|
|
|
|
;;; Tests
|
|
|
|
(ert-deftest edebug-tests-check-keymap ()
|
|
"Verify that `edebug-mode-map' is compatible with these tests.
|
|
If this test fails, one of two things is true. Either your
|
|
customizations modify `edebug-mode-map', in which case starting
|
|
Emacs with the -Q flag should fix the problem, or
|
|
`edebug-mode-map' has changed in edebug.el, in which case this
|
|
test and possibly others should be updated."
|
|
;; The reason verify-keybinding is a macro instead of a function is
|
|
;; that in the event of a failure, it makes the keybinding that
|
|
;; failed show up in ERT's output.
|
|
(cl-macrolet ((verify-keybinding (key binding)
|
|
`(should (eq (lookup-key edebug-mode-map ,key)
|
|
,binding))))
|
|
(verify-keybinding " " 'edebug-step-mode)
|
|
(verify-keybinding "n" 'edebug-next-mode)
|
|
(verify-keybinding "g" 'edebug-go-mode)
|
|
(verify-keybinding "G" 'edebug-Go-nonstop-mode)
|
|
(verify-keybinding "t" 'edebug-trace-mode)
|
|
(verify-keybinding "T" 'edebug-Trace-fast-mode)
|
|
(verify-keybinding "c" 'edebug-continue-mode)
|
|
(verify-keybinding "C" 'edebug-Continue-fast-mode)
|
|
(verify-keybinding "f" 'edebug-forward-sexp)
|
|
(verify-keybinding "h" 'edebug-goto-here)
|
|
(verify-keybinding "I" 'edebug-instrument-callee)
|
|
(verify-keybinding "i" 'edebug-step-in)
|
|
(verify-keybinding "o" 'edebug-step-out)
|
|
(verify-keybinding "q" 'top-level)
|
|
(verify-keybinding "Q" 'edebug-top-level-nonstop)
|
|
(verify-keybinding "a" 'abort-recursive-edit)
|
|
(verify-keybinding "S" 'edebug-stop)
|
|
(verify-keybinding "b" 'edebug-set-breakpoint)
|
|
(verify-keybinding "u" 'edebug-unset-breakpoint)
|
|
(verify-keybinding "B" 'edebug-next-breakpoint)
|
|
(verify-keybinding "x" 'edebug-set-conditional-breakpoint)
|
|
(verify-keybinding "X" 'edebug-set-global-break-condition)
|
|
(verify-keybinding "r" 'edebug-previous-result)
|
|
(verify-keybinding "e" 'edebug-eval-expression)
|
|
(verify-keybinding "\C-x\C-e" 'edebug-eval-last-sexp)
|
|
(verify-keybinding "E" 'edebug-visit-eval-list)
|
|
(verify-keybinding "w" 'edebug-where)
|
|
(verify-keybinding "v" 'edebug-view-outside) ;; maybe obsolete??
|
|
(verify-keybinding "p" 'edebug-bounce-point)
|
|
(verify-keybinding "P" 'edebug-view-outside) ;; same as v
|
|
(verify-keybinding "W" 'edebug-toggle-save-windows)
|
|
(verify-keybinding "?" 'edebug-help)
|
|
(verify-keybinding "d" 'edebug-pop-to-backtrace)
|
|
(verify-keybinding "-" 'negative-argument)
|
|
(verify-keybinding "=" 'edebug-temp-display-freq-count)
|
|
(should (eq (lookup-key backtrace-mode-map "n") 'backtrace-forward-frame))
|
|
(should (eq (lookup-key edebug-backtrace-mode-map "s")
|
|
'backtrace-goto-source))))
|
|
|
|
(ert-deftest edebug-tests-stop-point-at-start-of-first-instrumented-function ()
|
|
"Edebug stops at the beginning of an instrumented function."
|
|
(edebug-tests-with-normal-env
|
|
(edebug-tests-setup-@ "fac" '(0) t)
|
|
(edebug-tests-run-kbd-macro
|
|
"@" (edebug-tests-should-be-at "fac" "start")
|
|
"SPC" (edebug-tests-should-be-at "fac" "step")
|
|
"g" (should (equal edebug-tests-@-result 1)))))
|
|
|
|
(ert-deftest edebug-tests-step-showing-evaluation-results ()
|
|
"Edebug prints expression evaluation results to the echo area."
|
|
(edebug-tests-with-normal-env
|
|
(edebug-tests-setup-@ "concat" '("x" "y" nil) t)
|
|
(edebug-tests-run-kbd-macro
|
|
"@" (edebug-tests-should-be-at "concat" "start")
|
|
"SPC" (edebug-tests-should-be-at "concat" "flag")
|
|
(edebug-tests-should-match-result-in-messages "nil")
|
|
"SPC" (edebug-tests-should-be-at "concat" "else-start")
|
|
"SPC" (edebug-tests-should-be-at "concat" "else-b")
|
|
(edebug-tests-should-match-result-in-messages "\"y\"")
|
|
"SPC" (edebug-tests-should-be-at "concat" "else-a")
|
|
(edebug-tests-should-match-result-in-messages "\"x\"")
|
|
"SPC" (edebug-tests-should-be-at "concat" "else-concat")
|
|
(edebug-tests-should-match-result-in-messages "\"yx\"")
|
|
"SPC" (edebug-tests-should-be-at "concat" "if")
|
|
(edebug-tests-should-match-result-in-messages "\"yx\"")
|
|
"SPC" (should (equal edebug-tests-@-result "yx")))))
|
|
|
|
(ert-deftest edebug-tests-set-breakpoint-at-point ()
|
|
"Edebug can set a breakpoint at point."
|
|
(edebug-tests-with-normal-env
|
|
(edebug-tests-setup-@ "concat" '("x" "y" t) t)
|
|
(edebug-tests-run-kbd-macro
|
|
"@" (edebug-tests-should-be-at "concat" "start")
|
|
"C-n C-e b C-n" ; Move down, set a breakpoint and move away.
|
|
"g" (edebug-tests-should-be-at "concat" "then-concat")
|
|
(edebug-tests-should-match-result-in-messages "\"xy\"")
|
|
"g" (should (equal edebug-tests-@-result "xy")))))
|
|
|
|
(ert-deftest edebug-tests-set-temporary-breakpoint-at-point ()
|
|
"Edebug can set a temporary breakpoint at point."
|
|
(edebug-tests-with-normal-env
|
|
(edebug-tests-setup-@ "range" '(3) t)
|
|
(edebug-tests-run-kbd-macro
|
|
"@" (edebug-tests-should-be-at "range" "start")
|
|
"C-n C-n C-n C-e" ; Move down to the end of a sexp in the loop.
|
|
"C-u b" ; Set a temporary breakpoint.
|
|
"C-n" ; Move away.
|
|
"g" (edebug-tests-should-be-at "range" "loop")
|
|
(edebug-tests-should-match-result-in-messages "(0)")
|
|
"g" (should (equal edebug-tests-@-result '(0 1 2))))))
|
|
|
|
(ert-deftest edebug-tests-clear-breakpoint ()
|
|
"Edebug can clear a breakpoint."
|
|
(edebug-tests-with-normal-env
|
|
(edebug-tests-setup-@ "range" '(3) t)
|
|
(edebug-tests-run-kbd-macro
|
|
"@"
|
|
(message "after @")
|
|
(edebug-tests-should-be-at "range" "start")
|
|
"C-n C-n C-n C-e b C-n" ; Move down, set a breakpoint and move away.
|
|
"g" (edebug-tests-should-be-at "range" "loop")
|
|
(edebug-tests-should-match-result-in-messages "(0)")
|
|
"g" (edebug-tests-should-be-at "range" "loop")
|
|
(edebug-tests-should-match-result-in-messages "(1 0)")
|
|
"u" ; Unset the breakpoint.
|
|
"g" (should (equal edebug-tests-@-result '(0 1 2))))))
|
|
|
|
(ert-deftest edebug-tests-move-point-to-next-breakpoint ()
|
|
"Edebug can move point to the next breakpoint."
|
|
(edebug-tests-with-normal-env
|
|
(edebug-tests-setup-@ "concat" '("a" "b" nil) t)
|
|
(edebug-tests-run-kbd-macro
|
|
"@" (edebug-tests-should-be-at "concat" "start")
|
|
"C-n C-e b" ; Move down, set a breakpoint.
|
|
"C-n b" ; Set another breakpoint on the next line.
|
|
"C-p C-p C-p" ; Move back up.
|
|
"B" (edebug-tests-should-be-at "concat" "then-concat")
|
|
"B" (edebug-tests-should-be-at "concat" "else-concat")
|
|
"G" (should (equal edebug-tests-@-result "ba")))))
|
|
|
|
(ert-deftest edebug-tests-move-point-back-to-stop-point ()
|
|
"Edebug can move point back to a stop point."
|
|
(edebug-tests-with-normal-env
|
|
(let ((test-buffer (get-buffer-create "edebug-tests-temp")))
|
|
(edebug-tests-setup-@ "fac" '(4) t)
|
|
(edebug-tests-run-kbd-macro
|
|
"@" (edebug-tests-should-be-at "fac" "start")
|
|
"C-n w" (edebug-tests-should-be-at "fac" "start")
|
|
(pop-to-buffer test-buffer)
|
|
"C-x X w" (edebug-tests-should-be-at "fac" "start")
|
|
"g" (should (equal edebug-tests-@-result 24)))
|
|
(ignore-errors (kill-buffer test-buffer)))))
|
|
|
|
(ert-deftest edebug-tests-jump-to-point ()
|
|
"Edebug can stop at a temporary breakpoint at point."
|
|
(edebug-tests-with-normal-env
|
|
(edebug-tests-setup-@ "range" '(3) t)
|
|
(edebug-tests-run-kbd-macro
|
|
"@" (edebug-tests-should-be-at "range" "start")
|
|
"C-n C-n C-n C-e" ; Move down to the end of a sexp in the loop.
|
|
"h" (edebug-tests-should-be-at "range" "loop")
|
|
(edebug-tests-should-match-result-in-messages "(0)")
|
|
"g" (should (equal edebug-tests-@-result '(0 1 2))))))
|
|
|
|
(ert-deftest edebug-tests-jump-forward-one-sexp ()
|
|
"Edebug can run the program for one expression."
|
|
(edebug-tests-with-normal-env
|
|
(edebug-tests-setup-@ "range" '(3) t)
|
|
(edebug-tests-run-kbd-macro
|
|
"@" (edebug-tests-should-be-at "range" "start")
|
|
"SPC SPC f" (edebug-tests-should-be-at "range" "test")
|
|
"g" (should (equal edebug-tests-@-result '(0 1 2))))))
|
|
|
|
(ert-deftest edebug-tests-run-out-of-containing-sexp ()
|
|
"Edebug can run the program until the end of the containing sexp."
|
|
(edebug-tests-with-normal-env
|
|
(edebug-tests-setup-@ "range" '(3) t)
|
|
(edebug-tests-run-kbd-macro
|
|
"@" (edebug-tests-should-be-at "range" "start")
|
|
"SPC SPC f" (edebug-tests-should-be-at "range" "test")
|
|
"o" (edebug-tests-should-be-at "range" "end-loop")
|
|
(edebug-tests-should-match-result-in-messages "nil")
|
|
"g" (should (equal edebug-tests-@-result '(0 1 2))))))
|
|
|
|
(ert-deftest edebug-tests-observe-breakpoint-in-source ()
|
|
"Edebug will stop at a breakpoint embedded in source code."
|
|
(edebug-tests-with-normal-env
|
|
(edebug-tests-setup-@ "choices" '(8) t)
|
|
(edebug-tests-run-kbd-macro
|
|
"@" (edebug-tests-should-be-at "choices" "start")
|
|
"g" (edebug-tests-should-be-at "choices" "edebug")
|
|
"g" (should (equal edebug-tests-@-result nil)))))
|
|
|
|
(ert-deftest edebug-tests-set-conditional-breakpoint ()
|
|
"Edebug can set and observe a conditional breakpoint."
|
|
(edebug-tests-with-normal-env
|
|
(edebug-tests-setup-@ "fac" '(5) t)
|
|
(edebug-tests-run-kbd-macro
|
|
"@" (edebug-tests-should-be-at "fac" "start")
|
|
;; Set conditional breakpoint at end of next line.
|
|
"C-n C-e x (eql SPC n SPC 3) RET"
|
|
"g" (edebug-tests-should-be-at "fac" "mult")
|
|
(edebug-tests-should-match-result-in-messages "6 (#o6, #x6, ?\\C-f)")
|
|
"g" (should (equal edebug-tests-@-result 120)))))
|
|
|
|
(ert-deftest edebug-tests-error-trying-to-set-breakpoint-in-uninstrumented-code
|
|
()
|
|
"Edebug refuses to set a breakpoint in uninstrumented code."
|
|
(edebug-tests-with-normal-env
|
|
(edebug-tests-setup-@ "fac" '(5) t)
|
|
(let* ((debug-on-error nil)
|
|
(edebug-on-error nil)
|
|
error-message
|
|
(command-error-function (lambda (&rest args)
|
|
(setq error-message (cadar args)))))
|
|
(edebug-tests-run-kbd-macro
|
|
"@" (edebug-tests-should-be-at "fac" "start")
|
|
"C-u 10 C-n" ; Move down and out of instrumented function.
|
|
"b" (should (string-match-p "Not inside instrumented form"
|
|
error-message))
|
|
;; The error stopped the keyboard macro. Start it again.
|
|
(should-not executing-kbd-macro)
|
|
(setq executing-kbd-macro t)
|
|
"g"))))
|
|
|
|
(ert-deftest edebug-tests-set-and-break-on-global-condition ()
|
|
"Edebug can break when a global condition becomes true."
|
|
(edebug-tests-with-normal-env
|
|
(edebug-tests-setup-@ "multiply" '(5 3) t)
|
|
(edebug-tests-run-kbd-macro
|
|
"@" (edebug-tests-should-be-at "multiply" "start")
|
|
"X (> SPC edebug-test-code-total SPC 10) RET"
|
|
(should edebug-global-break-condition)
|
|
"g" (edebug-tests-should-be-at "multiply" "setq")
|
|
(should (eql (symbol-value 'edebug-test-code-total) 12))
|
|
"X C-a C-k nil RET" ; Remove suggestion before entering nil.
|
|
"g" (should (equal edebug-tests-@-result 15)))))
|
|
|
|
(ert-deftest edebug-tests-trace-showing-results-at-stop-points ()
|
|
"Edebug can trace execution, showing results at stop points."
|
|
(edebug-tests-with-normal-env
|
|
(edebug-tests-setup-@ "concat" '("x" "y" nil) t)
|
|
(edebug-tests-run-kbd-macro
|
|
"@" (edebug-tests-should-be-at "concat" "start")
|
|
"T" (should (string-match-p
|
|
(concat "Result: nil\n.*?"
|
|
"Result: \"y\"\n.*?"
|
|
"Result: \"x\"\n.*?"
|
|
"Result: \"yx\"\n.*?"
|
|
"Result: \"yx\"\n")
|
|
edebug-tests-messages))
|
|
(should (equal edebug-tests-@-result "yx")))))
|
|
|
|
(ert-deftest edebug-tests-trace-showing-results-at-breakpoints ()
|
|
"Edebug can trace execution, showing results at breakpoints."
|
|
(edebug-tests-with-normal-env
|
|
(edebug-tests-locate-def "format-vector-node")
|
|
(edebug-tests-run-kbd-macro "C-u C-M-x C-n C-n C-e C-x X b")
|
|
(edebug-tests-locate-def "format-list-node")
|
|
(edebug-tests-run-kbd-macro "C-u C-M-x C-n C-n C-e C-x X b")
|
|
(edebug-tests-setup-@ "format-node" '(([a b] [c d])) t)
|
|
(edebug-tests-run-kbd-macro
|
|
"@" (edebug-tests-should-be-at "format-node" "start")
|
|
"C" (should (string-match-p
|
|
(concat "Result: \"ab\"\n.*?"
|
|
"Result: \"cd\"\n.*?"
|
|
"Result: \"\\[ab]\\[cd]\"\n")
|
|
edebug-tests-messages))
|
|
(should (equal edebug-tests-@-result "{[ab][cd]}")))))
|
|
|
|
(ert-deftest edebug-tests-trace-function-call-and-return ()
|
|
"Edebug can create a trace of function calls and returns."
|
|
(edebug-tests-with-normal-env
|
|
(edebug-tests-locate-def "format-vector-node")
|
|
(eval-defun t)
|
|
(edebug-tests-locate-def "format-list-node")
|
|
(eval-defun t)
|
|
(edebug-tests-setup-@ "format-node" '((a [b])) t)
|
|
(let ((edebug-trace t)
|
|
(trace-start (with-current-buffer
|
|
(get-buffer-create edebug-trace-buffer) (point-max))))
|
|
(edebug-tests-run-kbd-macro
|
|
"@" (edebug-tests-should-be-at "format-node" "start")
|
|
"g" (should (equal edebug-tests-@-result "{a[b]}")))
|
|
(with-current-buffer edebug-trace-buffer
|
|
(should (string=
|
|
"{ edebug-test-code-format-node args: ((a [b]))
|
|
:{ edebug-test-code-format-list-node args: ((a [b]))
|
|
::{ edebug-test-code-format-node args: (a)
|
|
::} edebug-test-code-format-node result: a
|
|
::{ edebug-test-code-format-node args: ([b])
|
|
:::{ edebug-test-code-format-vector-node args: ([b])
|
|
::::{ edebug-test-code-format-node args: (b)
|
|
::::} edebug-test-code-format-node result: b
|
|
:::} edebug-test-code-format-vector-node result: [b]
|
|
::} edebug-test-code-format-node result: [b]
|
|
:} edebug-test-code-format-list-node result: {a[b]}
|
|
} edebug-test-code-format-node result: {a[b]}
|
|
" (buffer-substring trace-start (point-max))))))))
|
|
|
|
(ert-deftest edebug-tests-evaluate-expressions ()
|
|
"Edebug can evaluate an expression in the context outside of itself."
|
|
(edebug-tests-with-normal-env
|
|
(edebug-tests-setup-@ "range" '(2) t)
|
|
(edebug-tests-run-kbd-macro
|
|
"@" (edebug-tests-should-be-at "range" "start")
|
|
"SPC SPC f" (edebug-tests-should-be-at "range" "test")
|
|
(edebug-tests-should-match-result-in-messages "t")
|
|
"e (- SPC num SPC index) RET"
|
|
;; Edebug just prints the result without "Result:"
|
|
(should (string-match-p
|
|
(regexp-quote "2 (#o2, #x2, ?\\C-b)")
|
|
edebug-tests-messages))
|
|
"g" (should (equal edebug-tests-@-result '(0 1))))
|
|
|
|
;; Do it again with lexical-binding turned off.
|
|
(setq lexical-binding nil)
|
|
(eval-buffer)
|
|
(should-not lexical-binding)
|
|
(edebug-tests-setup-@ "range" '(2) t)
|
|
(edebug-tests-run-kbd-macro
|
|
"@" (edebug-tests-should-be-at "range" "start")
|
|
"SPC SPC f" (edebug-tests-should-be-at "range" "test")
|
|
(edebug-tests-should-match-result-in-messages "t")
|
|
"e (- SPC num SPC index) RET"
|
|
;; Edebug just prints the result without "Result:"
|
|
(should (string-match-p
|
|
(regexp-quote "2 (#o2, #x2, ?\\C-b)")
|
|
edebug-tests-messages))
|
|
"g" (should (equal edebug-tests-@-result '(0 1))))))
|
|
|
|
(ert-deftest edebug-tests-step-into-function ()
|
|
"Edebug can step into a function."
|
|
(edebug-tests-with-normal-env
|
|
(edebug-tests-setup-@ "format-node" '([b]) t)
|
|
(edebug-tests-run-kbd-macro
|
|
"@" (edebug-tests-should-be-at "format-node" "start")
|
|
"SPC SPC SPC SPC"
|
|
(edebug-tests-should-be-at "format-node" "vbefore")
|
|
"i" (edebug-tests-should-be-at "format-vector-node" "start")
|
|
"g" (should (equal edebug-tests-@-result "[b]")))))
|
|
|
|
(ert-deftest edebug-tests-error-stepping-into-subr ()
|
|
"Edebug refuses to step into a C function."
|
|
(edebug-tests-with-normal-env
|
|
(edebug-tests-setup-@ "format-node" '([b]) t)
|
|
(let* ((debug-on-error nil)
|
|
(edebug-on-error nil)
|
|
error-message
|
|
(command-error-function (lambda (&rest args)
|
|
(setq error-message (cadar args)))))
|
|
(edebug-tests-run-kbd-macro
|
|
"@" (edebug-tests-should-be-at "format-node" "start")
|
|
"SPC" (edebug-tests-should-be-at "format-node" "vectorp")
|
|
"i" (should (string-match-p "vectorp is a built-in function"
|
|
error-message))
|
|
;; The error stopped the keyboard macro. Start it again.
|
|
(should-not executing-kbd-macro)
|
|
(setq executing-kbd-macro t)
|
|
"g" (should (equal edebug-tests-@-result "[b]"))))))
|
|
|
|
(ert-deftest edebug-tests-step-into-macro-error ()
|
|
"Edebug gives an error on trying to step into a macro (Bug#26847)."
|
|
:expected-result :failed
|
|
(ert-fail "Forcing failure because letting this test run aborts the others.")
|
|
(edebug-tests-with-normal-env
|
|
(edebug-tests-setup-@ "try-flavors" nil t)
|
|
(let* ((debug-on-error nil)
|
|
(edebug-on-error nil)
|
|
(error-message "")
|
|
(command-error-function (lambda (&rest args)
|
|
(setq error-message (cadar args)))))
|
|
(edebug-tests-run-kbd-macro
|
|
"@ SPC SPC SPC SPC SPC"
|
|
(edebug-tests-should-be-at "try-flavors" "macro")
|
|
"i" (should (string-match-p "edebug-test-code-try-flavors is a macro"
|
|
error-message))
|
|
;; The error stopped the keyboard macro. Start it again.
|
|
(should-not executing-kbd-macro)
|
|
(setq executing-kbd-macro t)
|
|
"g" (should (equal edebug-tests-@-result
|
|
'("chocolate" "strawberry")))))))
|
|
|
|
(ert-deftest edebug-tests-step-into-generic-method ()
|
|
"Edebug can step into a generic method (Bug#22294)."
|
|
(edebug-tests-with-normal-env
|
|
(edebug-tests-setup-@ "use-methods" nil t)
|
|
(edebug-tests-run-kbd-macro
|
|
"@ SPC" (edebug-tests-should-be-at "use-methods" "number")
|
|
"i" (edebug-tests-should-be-at "emphasize-1" "start")
|
|
"gg" (should (equal edebug-tests-@-result
|
|
'("The number is not 101 or 99, but 100!"
|
|
"***yes***"))))))
|
|
|
|
(ert-deftest edebug-tests-break-in-lambda-out-of-defining-context ()
|
|
"Edebug observes a breakpoint in a lambda executed out of defining context."
|
|
(edebug-tests-with-normal-env
|
|
(edebug-tests-locate-def "make-lambda")
|
|
(eval-defun t)
|
|
(goto-char (edebug-tests-get-stop-point "make-lambda" "x"))
|
|
(edebug-set-breakpoint t)
|
|
(edebug-tests-setup-@ "use-lambda" nil t)
|
|
(edebug-tests-run-kbd-macro
|
|
"@g" (edebug-tests-should-be-at "make-lambda" "x")
|
|
(edebug-tests-should-match-result-in-messages "1 (#o1, #x1, ?\\C-a)")
|
|
"g" (should (equal edebug-tests-@-result '(11 12 13))))))
|
|
|
|
(ert-deftest edebug-tests-respects-initial-mode ()
|
|
"Edebug can stop first at breakpoint instead of first instrumented function."
|
|
(edebug-tests-with-normal-env
|
|
(edebug-tests-setup-@ "fac" '(4) t)
|
|
(goto-char (edebug-tests-get-stop-point "fac" "mult"))
|
|
(edebug-set-breakpoint t)
|
|
(setq edebug-initial-mode 'go)
|
|
(edebug-tests-run-kbd-macro
|
|
"@" (edebug-tests-should-be-at "fac" "mult")
|
|
(edebug-tests-should-match-result-in-messages "1 (#o1, #x1, ?\\C-a)")
|
|
"G" (should (equal edebug-tests-@-result 24)))))
|
|
|
|
(ert-deftest edebug-tests-step-through-non-definition ()
|
|
"Edebug can step through a non-defining form."
|
|
(edebug-tests-with-normal-env
|
|
(goto-char (edebug-tests-get-stop-point "try-flavors" "end-unless"))
|
|
(edebug-tests-run-kbd-macro
|
|
"C-u C-M-x"
|
|
"SPC SPC" (edebug-tests-should-be-at "try-flavors" "nutty")
|
|
(edebug-tests-should-match-result-in-messages "nil")
|
|
"SPC" (edebug-tests-should-be-at "try-flavors" "setq")
|
|
"f" (edebug-tests-should-be-at "try-flavors" "end-setq")
|
|
(edebug-tests-should-match-result-in-messages "\"chocolate\"")
|
|
"g")))
|
|
|
|
(ert-deftest edebug-tests-conditional-breakpoints-can-use-lexical-variables ()
|
|
"Edebug can set a conditional breakpoint using a lexical variable. Bug#12685"
|
|
(edebug-tests-with-normal-env
|
|
(should lexical-binding)
|
|
(edebug-tests-setup-@ "fac" '(5) t)
|
|
(edebug-tests-run-kbd-macro
|
|
"@" (edebug-tests-should-be-at "fac" "start")
|
|
;; Set conditional breakpoint at end of next line.
|
|
"C-n C-e x (eql SPC n SPC 3) RET"
|
|
"g" (edebug-tests-should-be-at "fac" "mult")
|
|
(edebug-tests-should-match-result-in-messages
|
|
"6 (#o6, #x6, ?\\C-f)"))))
|
|
|
|
(ert-deftest edebug-tests-writable-buffer-state-is-preserved ()
|
|
"On Edebug exit writable buffers are still writable (Bug#14144)."
|
|
(edebug-tests-with-normal-env
|
|
(edebug-tests-setup-@ "choices" '(0) t)
|
|
(read-only-mode -1)
|
|
(edebug-tests-run-kbd-macro
|
|
"@g" (should (equal edebug-tests-@-result "zero")))
|
|
(barf-if-buffer-read-only)))
|
|
|
|
(ert-deftest edebug-tests-list-containing-empty-string-result-printing ()
|
|
"Edebug correctly prints a list containing only an empty string (Bug#17934)."
|
|
(edebug-tests-with-normal-env
|
|
(edebug-tests-setup-@ "empty-string-list" nil t)
|
|
(edebug-tests-run-kbd-macro
|
|
"@ SPC" (edebug-tests-should-be-at
|
|
"empty-string-list" "step")
|
|
(edebug-tests-should-match-result-in-messages "(\"\")")
|
|
"g")))
|
|
|
|
(ert-deftest edebug-tests-evaluation-of-current-buffer-bug-19611 ()
|
|
"Edebug can evaluate `current-buffer' in correct context. (Bug#19611)."
|
|
(edebug-tests-with-normal-env
|
|
(edebug-tests-setup-@ "current-buffer" nil t)
|
|
(edebug-tests-run-kbd-macro
|
|
"@" (edebug-tests-should-be-at
|
|
"current-buffer" "start")
|
|
"SPC SPC SPC" (edebug-tests-should-be-at
|
|
"current-buffer" "body")
|
|
"e (current-buffer) RET"
|
|
;; Edebug just prints the result without "Result:"
|
|
(should (string-match-p
|
|
(regexp-quote "*edebug-test-code-buffer*")
|
|
edebug-tests-messages))
|
|
"g" (should (equal edebug-tests-@-result
|
|
"current-buffer: *edebug-test-code-buffer*")))))
|
|
|
|
(ert-deftest edebug-tests-trivial-backquote ()
|
|
"Edebug can instrument a trivial backquote expression (Bug#23651)."
|
|
(edebug-tests-with-normal-env
|
|
(let ((inhibit-read-only t))
|
|
(delete-region (point-min) (point-max))
|
|
(insert "`1"))
|
|
(eval-defun nil)
|
|
;; `eval-defun' outputs its message to the echo area in a rather
|
|
;; funny way, so the "1" and the " (#o1, #x1, ?\C-a)" end up placed
|
|
;; there in separate pieces (via `print' rather than via `message').
|
|
(should (string-match-p (regexp-quote " (#o1, #x1, ?\\C-a)")
|
|
edebug-tests-messages))
|
|
(setq edebug-tests-messages "")
|
|
|
|
(setq edebug-initial-mode 'go)
|
|
;; In Bug#23651 Edebug would hang reading `1.
|
|
(eval-defun t)
|
|
(should (string-match-p (regexp-quote " (#o1, #x1, ?\\C-a)")
|
|
edebug-tests-messages))))
|
|
|
|
(ert-deftest edebug-tests-trivial-comma ()
|
|
"Edebug can read a trivial comma expression (Bug#23651)."
|
|
(edebug-tests-with-normal-env
|
|
(let ((inhibit-read-only t))
|
|
(delete-region (point-min) (point-max))
|
|
(insert ",1"))
|
|
;; FIXME: This currently signals a "Source has changed" error, which is
|
|
;; itself a bug (the source hasn't changed). All we're testing here
|
|
;; is that the Edebug gets past the step of reading the sexp.
|
|
(should-error (let ((eval-expression-debug-on-error nil))
|
|
(eval-defun t)))))
|
|
|
|
(ert-deftest edebug-tests-circular-read-syntax ()
|
|
"Edebug can instrument code using circular read object syntax (Bug#23660)."
|
|
(edebug-tests-with-normal-env
|
|
(edebug-tests-setup-@ "circular-read-syntax" nil t)
|
|
(edebug-tests-run-kbd-macro
|
|
"@" (should (eql (car edebug-tests-@-result)
|
|
(cdr edebug-tests-@-result))))))
|
|
|
|
(ert-deftest edebug-tests-hash-read-syntax ()
|
|
"Edebug can instrument code which uses # read syntax (Bug#25068)."
|
|
(edebug-tests-with-normal-env
|
|
(edebug-tests-setup-@ "hash-read-syntax" nil t)
|
|
(edebug-tests-run-kbd-macro
|
|
"@g" (should (equal edebug-tests-@-result
|
|
'(#("abcd" 1 3 (face italic)) 511))))))
|
|
|
|
(ert-deftest edebug-tests-dotted-forms ()
|
|
"Edebug can instrument code matching the tail of a dotted spec (Bug#6415)."
|
|
(edebug-tests-with-normal-env
|
|
(edebug-tests-setup-@ "use-destructuring-bind" nil t)
|
|
(edebug-tests-run-kbd-macro
|
|
"@ SPC SPC SPC SPC SPC SPC"
|
|
(edebug-tests-should-be-at "use-destructuring-bind" "x")
|
|
(edebug-tests-should-match-result-in-messages "2 (#o2, #x2, ?\\C-b)")
|
|
"SPC"
|
|
(edebug-tests-should-be-at "use-destructuring-bind" "y")
|
|
(edebug-tests-should-match-result-in-messages "3 (#o3, #x3, ?\\C-c)")
|
|
"g"
|
|
(should (equal edebug-tests-@-result 5)))))
|
|
|
|
(ert-deftest edebug-tests-cl-macrolet ()
|
|
"Edebug can instrument `cl-macrolet' expressions. (Bug#29919)"
|
|
(edebug-tests-with-normal-env
|
|
(edebug-tests-locate-def "use-cl-macrolet")
|
|
(edebug-tests-run-kbd-macro
|
|
"C-u C-M-x SPC"
|
|
(edebug-tests-should-be-at "use-cl-macrolet" "func")
|
|
(edebug-tests-should-match-result-in-messages "+"))
|
|
(let ((edebug-initial-mode 'Go-nonstop))
|
|
(edebug-tests-setup-@ "use-cl-macrolet" '(10) t))
|
|
(edebug-tests-run-kbd-macro
|
|
"@ SPC g"
|
|
(should (equal edebug-tests-@-result "The result of applying + to (1 x) is 11"))
|
|
)))
|
|
|
|
(ert-deftest edebug-tests-backtrace-goto-source ()
|
|
"Edebug can jump to instrumented source from its *Edebug-Backtrace* buffer."
|
|
(edebug-tests-with-normal-env
|
|
(edebug-tests-setup-@ "range" '(2) t)
|
|
(edebug-tests-run-kbd-macro
|
|
"@ SPC SPC"
|
|
(edebug-tests-should-be-at "range" "lt")
|
|
"dns" ; Pop to backtrace, next frame, goto source.
|
|
(edebug-tests-should-be-at "range" "start")
|
|
"g"
|
|
(should (equal edebug-tests-@-result '(0 1))))))
|
|
|
|
(ert-deftest edebug-cl-defmethod-qualifier ()
|
|
"Check that secondary `cl-defmethod' forms don't stomp over
|
|
primary ones (Bug#42671)."
|
|
(with-temp-buffer
|
|
(let* ((edebug-all-defs t)
|
|
(edebug-initial-mode 'Go-nonstop)
|
|
(defined-symbols ())
|
|
(edebug-new-definition-function
|
|
(lambda (def-name)
|
|
(push def-name defined-symbols)
|
|
(edebug-new-definition def-name))))
|
|
(dolist (form '((cl-defmethod edebug-cl-defmethod-qualifier ((_ number)))
|
|
(cl-defmethod edebug-cl-defmethod-qualifier
|
|
:around ((_ number)))))
|
|
(print form (current-buffer)))
|
|
(eval-buffer)
|
|
(should
|
|
(equal
|
|
defined-symbols
|
|
(list (intern "edebug-cl-defmethod-qualifier :around (number)")
|
|
(intern "edebug-cl-defmethod-qualifier (number)")))))))
|
|
|
|
(ert-deftest edebug-tests--conflicting-internal-names ()
|
|
"Check conflicts between form's head symbols and Edebug spec elements."
|
|
(edebug-tests-with-normal-env
|
|
(edebug-tests-setup-@ "cl-flet1" '(10) t)))
|
|
|
|
(ert-deftest edebug-tests-gv-expander ()
|
|
"Edebug can instrument `gv-expander' expressions."
|
|
(edebug-tests-with-normal-env
|
|
(edebug-tests-setup-@ "use-gv-expander" nil t)
|
|
(should (equal
|
|
(catch 'text
|
|
(run-at-time 0 nil
|
|
(lambda () (throw 'text (buffer-substring (point) (+ (point) 5)))))
|
|
(eval '(setf (edebug-test-code-use-gv-expander (cons 'a 'b)) 3) t))
|
|
"(func"))))
|
|
|
|
(defun edebug-tests--read (form spec)
|
|
(with-temp-buffer
|
|
(print form (current-buffer))
|
|
(goto-char (point-min))
|
|
(cl-letf ((edebug-all-forms t)
|
|
((get (car form) 'edebug-form-spec) spec))
|
|
(edebug--read nil (current-buffer)))))
|
|
|
|
(ert-deftest edebug-tests--&rest-behavior ()
|
|
;; `&rest' is documented to allow the last "repetition" to be aborted early.
|
|
(should (edebug-tests--read '(dummy x 1 y 2 z)
|
|
'(&rest symbolp integerp)))
|
|
;; `&rest' should notice here that the "symbolp integerp" sequence
|
|
;; is not respected.
|
|
(should-error (edebug-tests--read '(dummy x 1 2 y)
|
|
'(&rest symbolp integerp))))
|
|
|
|
(ert-deftest edebug-tests-cl-flet ()
|
|
"Check that Edebug can instrument `cl-flet' forms without name
|
|
clashes (Bug#41853)."
|
|
(with-temp-buffer
|
|
(dolist (form '((defun edebug-tests-cl-flet-1 ()
|
|
(cl-flet ((inner () 0)) (message "Hi"))
|
|
(cl-flet ((inner () 1)) (inner)))
|
|
(defun edebug-tests-cl-flet-2 ()
|
|
(cl-flet ((inner () 2)) (inner)))))
|
|
(print form (current-buffer)))
|
|
(let* ((edebug-all-defs t)
|
|
(edebug-initial-mode 'Go-nonstop)
|
|
(instrumented-names ())
|
|
(edebug-new-definition-function
|
|
(lambda (name)
|
|
(when (memq name instrumented-names)
|
|
(error "Duplicate definition of `%s'" name))
|
|
(push name instrumented-names)
|
|
(edebug-new-definition name)))
|
|
;; Make generated symbols reproducible.
|
|
(gensym-counter 10000))
|
|
(eval-buffer)
|
|
;; Use `format' so as to throw away differences due to
|
|
;; interned/uninterned symbols.
|
|
(should (equal (format "%s" (reverse instrumented-names))
|
|
;; The outer definitions come after the inner
|
|
;; ones because their body ends later.
|
|
;; FIXME: We'd rather have names such as
|
|
;; `edebug-tests-cl-flet-1@inner@cl-flet@10000',
|
|
;; but that requires further changes to Edebug.
|
|
(format "%s" '(inner@cl-flet@10000
|
|
inner@cl-flet@10001
|
|
edebug-tests-cl-flet-1
|
|
inner@cl-flet@10002
|
|
edebug-tests-cl-flet-2)))))))
|
|
|
|
(defmacro edebug-tests--duplicate-symbol-backtrack (arg)
|
|
"Helper macro that exemplifies Bug#42701.
|
|
ARG is either (FORM) or (FORM IGNORED)."
|
|
(declare (debug ([&or (form) (form sexp)])))
|
|
(car arg))
|
|
|
|
(ert-deftest edebug-tests-duplicate-symbol-backtrack ()
|
|
"Check that Edebug doesn't create duplicate symbols when
|
|
backtracking (Bug#42701)."
|
|
(with-temp-buffer
|
|
(print '(defun edebug-tests-duplicate-symbol-backtrack ()
|
|
(edebug-tests--duplicate-symbol-backtrack
|
|
;; Passing (FORM IGNORED) forces backtracking.
|
|
((lambda () 123) ignored)))
|
|
(current-buffer))
|
|
(let* ((edebug-all-defs t)
|
|
(edebug-initial-mode 'Go-nonstop)
|
|
(instrumented-names ())
|
|
(edebug-new-definition-function
|
|
(lambda (name)
|
|
(when (memq name instrumented-names)
|
|
(error "Duplicate definition of `%s'" name))
|
|
(push name instrumented-names)
|
|
(edebug-new-definition name)))
|
|
;; Make generated symbols reproducible.
|
|
(gensym-counter 10000))
|
|
(eval-buffer)
|
|
;; The anonymous symbols are uninterned. Use their names so we
|
|
;; can perform the assertion. The names should still be unique.
|
|
(should (equal (mapcar #'symbol-name (reverse instrumented-names))
|
|
;; The outer definition comes after the inner
|
|
;; ones because its body ends later.
|
|
;; FIXME: There are twice as many inner
|
|
;; definitions as expected due to Bug#42701.
|
|
;; Once that bug is fixed, remove the duplicates.
|
|
'("edebug-anon10000"
|
|
"edebug-anon10001"
|
|
"edebug-tests-duplicate-symbol-backtrack"))))))
|
|
|
|
(defmacro edebug-tests--duplicate-&define (_arg)
|
|
"Helper macro for the ERT test `edebug-tests-duplicate-&define'.
|
|
The Edebug specification is similar to the one used by `cl-flet'
|
|
previously; see Bug#41988."
|
|
(declare (debug (&or (&define name function-form) (defun)))))
|
|
|
|
(ert-deftest edebug-tests-duplicate-&define ()
|
|
"Check that Edebug doesn't backtrack out of `&define' forms.
|
|
This avoids potential duplicate definitions (Bug#41988)."
|
|
(with-temp-buffer
|
|
(print '(defun edebug-tests-duplicate-&define ()
|
|
(edebug-tests--duplicate-&define
|
|
(edebug-tests-duplicate-&define-inner () nil)))
|
|
(current-buffer))
|
|
(let* ((edebug-all-defs t)
|
|
(edebug-initial-mode 'Go-nonstop)
|
|
(instrumented-names ())
|
|
(edebug-new-definition-function
|
|
(lambda (name)
|
|
(when (memq name instrumented-names)
|
|
(error "Duplicate definition of `%s'" name))
|
|
(push name instrumented-names)
|
|
(edebug-new-definition name))))
|
|
(should-error (eval-buffer) :type 'invalid-read-syntax))))
|
|
|
|
(ert-deftest edebug-tests-inline ()
|
|
"Check that Edebug can instrument inline functions (Bug#53068)."
|
|
(with-temp-buffer
|
|
(print '(define-inline edebug-tests-inline (arg)
|
|
(inline-quote ,arg))
|
|
(current-buffer))
|
|
(let ((edebug-all-defs t)
|
|
(edebug-initial-mode 'Go-nonstop))
|
|
(eval-buffer))))
|
|
|
|
(ert-deftest edebug-test-dot-reader ()
|
|
(with-temp-buffer
|
|
(insert "(defun x () `(t .,t))")
|
|
(goto-char (point-min))
|
|
(should (equal (save-excursion
|
|
(edebug-read-storing-offsets (current-buffer)))
|
|
(save-excursion
|
|
(read (current-buffer)))))))
|
|
|
|
(provide 'edebug-tests)
|
|
;;; edebug-tests.el ends here
|