mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-17 10:06:13 +00:00
Add more tests for backtrace-mode
* test/lisp/emacs-lisp/backtrace-tests.el (backtrace-tests--variables) (backtrace-tests--backward-frame, backtrace-tests--forward-frame) (backtrace-tests--pretty-print-and-collapse) (backtrace-tests--verify-pp-and-collapse) (backtrace-tests--print-circle, backtrace-tests--make-regexp) (backtrace-tests--expand-ellipsis): New tests. (backtrace-tests--to-string): Use backtrace-tests--make-backtrace. (backtrace-tests--get-substring): New function. Change the method of generating sample backtraces in backtrace tests to work whether or not the tests are byte-compiled. * test/lisp/emacs-lisp/backtrace-tests.el (backtrace-tests--func1) (backtrace-tests--func2, backtrace-tests--func3) (backtrace-tests--create-backtrace-frames): Remove. (backtrace-tests--uncompiled-functions): New constant. (backtrace-tests--make-backtrace, backtrace-tests--setup-buffer): New functions. (backtrace-tests--backtrace-lines) (backtrace-tests--backtrace-lines-with-locals): New functions. (backtrace-tests--line-count): New constant. (backtrace-tests--result, backtrace-tests--result-with-locals): New functions. (backtrace-tests--header): New constant. (backtrace-tests--insert-header): Use backtrace-tests--header. (backtrace-tests--with-buffer): Remove.
This commit is contained in:
Gemini Lasswell
parent
af5f3771fd
commit
04cc0b6158
@ -1,4 +1,4 @@
|
||||
;;; backtrace-tests.el --- Tests for emacs-lisp/backtrace.el -*- lexical-binding: t; -*-
|
||||
;;; backtrace-tests.el --- Tests for backtraces -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2018 Free Software Foundation, Inc.
|
||||
|
||||
@ -23,67 +23,372 @@
|
||||
|
||||
(require 'backtrace)
|
||||
(require 'ert)
|
||||
(require 'ert-x)
|
||||
(require 'seq)
|
||||
|
||||
;; Create a backtrace frames list with several frames.
|
||||
;; TODO load this from an el file in backtrace-resources/ so the tests
|
||||
;; can be byte-compiled.
|
||||
(defvar backtrace-tests--frames nil)
|
||||
;; Delay evaluation of the backtrace-creating functions until
|
||||
;; load so that the backtraces are the same whether this file
|
||||
;; is compiled or not.
|
||||
|
||||
(defun backtrace-tests--func1 (arg1 arg2)
|
||||
(setq backtrace-tests--frames (backtrace-get-frames nil))
|
||||
(list arg1 arg2))
|
||||
(eval-and-compile
|
||||
(defconst backtrace-tests--uncompiled-functions
|
||||
'(progn
|
||||
(defun backtrace-tests--make-backtrace (arg)
|
||||
(backtrace-tests--setup-buffer))
|
||||
|
||||
(defun backtrace-tests--func2 (arg)
|
||||
(list arg))
|
||||
(defun backtrace-tests--setup-buffer ()
|
||||
"Set up the current buffer in backtrace mode."
|
||||
(backtrace-mode)
|
||||
(setq backtrace-frames (backtrace-get-frames))
|
||||
(let ((this-index))
|
||||
;; Discard all past `backtrace-tests-make-backtrace'.
|
||||
(dotimes (index (length backtrace-frames))
|
||||
(when (eq (backtrace-frame-fun (nth index backtrace-frames))
|
||||
'backtrace-tests--make-backtrace)
|
||||
(setq this-index index)))
|
||||
(setq backtrace-frames (seq-subseq backtrace-frames 0 (1+ this-index))))
|
||||
(backtrace-print))))
|
||||
|
||||
(defun backtrace-tests--func3 (arg)
|
||||
(let ((foo (list 'a arg 'b)))
|
||||
(list foo (backtrace-tests--func2 arg) (backtrace-tests--func1 arg 0))))
|
||||
(eval backtrace-tests--uncompiled-functions))
|
||||
|
||||
(defun backtrace-tests--create-backtrace-frames ()
|
||||
(backtrace-tests--func3 "string")
|
||||
;; Discard frames before this one.
|
||||
(let (this-index)
|
||||
(dotimes (index (length backtrace-tests--frames))
|
||||
(when (eq (backtrace-frame-fun (nth index backtrace-tests--frames))
|
||||
'backtrace-tests--create-backtrace-frames)
|
||||
(setq this-index index)))
|
||||
(setq backtrace-tests--frames (seq-subseq backtrace-tests--frames
|
||||
0 (1+ this-index)))))
|
||||
(defun backtrace-tests--backtrace-lines ()
|
||||
(if debugger-stack-frame-as-list
|
||||
'(" (backtrace-get-frames)\n"
|
||||
" (setq backtrace-frames (backtrace-get-frames))\n"
|
||||
" (backtrace-tests--setup-buffer)\n"
|
||||
" (backtrace-tests--make-backtrace %s)\n")
|
||||
'(" backtrace-get-frames()\n"
|
||||
" (setq backtrace-frames (backtrace-get-frames))\n"
|
||||
" backtrace-tests--setup-buffer()\n"
|
||||
" backtrace-tests--make-backtrace(%s)\n")))
|
||||
|
||||
(backtrace-tests--create-backtrace-frames)
|
||||
(defconst backtrace-tests--line-count (length (backtrace-tests--backtrace-lines)))
|
||||
|
||||
(defun backtrace-tests--backtrace-lines-with-locals ()
|
||||
(let ((lines (backtrace-tests--backtrace-lines))
|
||||
(locals '(" [no locals]\n"
|
||||
" [no locals]\n"
|
||||
" [no locals]\n"
|
||||
" arg = %s\n")))
|
||||
(apply #'append (cl-mapcar #'list lines locals))))
|
||||
|
||||
(defun backtrace-tests--result (value)
|
||||
(format (apply #'concat (backtrace-tests--backtrace-lines))
|
||||
(cl-prin1-to-string value)))
|
||||
|
||||
(defun backtrace-tests--result-with-locals (value)
|
||||
(let ((str (cl-prin1-to-string value)))
|
||||
(format (apply #'concat (backtrace-tests--backtrace-lines-with-locals))
|
||||
str str)))
|
||||
|
||||
;; TODO check that debugger-batch-max-lines still works
|
||||
|
||||
(defconst backtrace-tests--header "Test header\n")
|
||||
(defun backtrace-tests--insert-header ()
|
||||
(insert "Test header\n"))
|
||||
|
||||
(defmacro backtrace-tests--with-buffer (&rest body)
|
||||
`(with-temp-buffer
|
||||
(backtrace-mode)
|
||||
(setq backtrace-frames backtrace-tests--frames)
|
||||
(setq backtrace-insert-header-function #'backtrace-tests--insert-header)
|
||||
(backtrace-print)
|
||||
,@body))
|
||||
(insert backtrace-tests--header))
|
||||
|
||||
;;; Tests
|
||||
|
||||
(ert-deftest backtrace-tests--variables ()
|
||||
"Backtrace buffers can show and hide local variables."
|
||||
(ert-with-test-buffer (:name "variables")
|
||||
(let ((results (concat backtrace-tests--header
|
||||
(backtrace-tests--result 'value)))
|
||||
(last-frame (format (nth (1- backtrace-tests--line-count)
|
||||
(backtrace-tests--backtrace-lines)) 'value))
|
||||
(last-frame-with-locals
|
||||
(format (apply #'concat (nthcdr (* 2 (1- backtrace-tests--line-count))
|
||||
(backtrace-tests--backtrace-lines-with-locals)))
|
||||
'value 'value)))
|
||||
(backtrace-tests--make-backtrace 'value)
|
||||
(setq backtrace-insert-header-function #'backtrace-tests--insert-header)
|
||||
(backtrace-print)
|
||||
(should (string= (backtrace-tests--get-substring (point-min) (point-max))
|
||||
results))
|
||||
;; Go to the last frame.
|
||||
(goto-char (point-max))
|
||||
(forward-line -1)
|
||||
;; Turn on locals for that frame.
|
||||
(backtrace-toggle-locals)
|
||||
(should (string= (backtrace-tests--get-substring (point) (point-max))
|
||||
last-frame-with-locals))
|
||||
(should (string= (backtrace-tests--get-substring (point-min) (point-max))
|
||||
(concat results
|
||||
(format (car (last (backtrace-tests--backtrace-lines-with-locals)))
|
||||
'value))))
|
||||
;; Turn off locals for that frame.
|
||||
(backtrace-toggle-locals)
|
||||
(should (string= (backtrace-tests--get-substring (point) (point-max))
|
||||
last-frame))
|
||||
(should (string= (backtrace-tests--get-substring (point-min) (point-max))
|
||||
results))
|
||||
;; Turn all locals on.
|
||||
(backtrace-toggle-locals '(4))
|
||||
(should (string= (backtrace-tests--get-substring (point) (point-max))
|
||||
last-frame-with-locals))
|
||||
(should (string= (backtrace-tests--get-substring (point-min) (point-max))
|
||||
(concat backtrace-tests--header
|
||||
(backtrace-tests--result-with-locals 'value))))
|
||||
;; Turn all locals off.
|
||||
(backtrace-toggle-locals '(4))
|
||||
(should (string= (backtrace-tests--get-substring
|
||||
(point) (+ (point) (length last-frame)))
|
||||
last-frame))
|
||||
(should (string= (backtrace-tests--get-substring (point-min) (point-max))
|
||||
results)))))
|
||||
|
||||
(ert-deftest backtrace-tests--backward-frame ()
|
||||
"`backtrace-backward-frame' moves backward to the start of a frame."
|
||||
(ert-with-test-buffer (:name "backward")
|
||||
(let ((results (concat backtrace-tests--header
|
||||
(backtrace-tests--result nil))))
|
||||
(backtrace-tests--make-backtrace nil)
|
||||
(setq backtrace-insert-header-function #'backtrace-tests--insert-header)
|
||||
(backtrace-print)
|
||||
(should (string= (backtrace-tests--get-substring (point-min) (point-max))
|
||||
results))
|
||||
|
||||
;; Try to move backward from header.
|
||||
(goto-char (+ (point-min) (/ (length backtrace-tests--header) 2)))
|
||||
(let ((pos (point)))
|
||||
(should-error (backtrace-backward-frame))
|
||||
(should (= pos (point))))
|
||||
|
||||
;; Try to move backward from start of first line.
|
||||
(forward-line)
|
||||
(let ((pos (point)))
|
||||
(should-error (backtrace-backward-frame))
|
||||
(should (= pos (point))))
|
||||
|
||||
;; Move backward from middle of line.
|
||||
(let ((start (point)))
|
||||
(forward-char (/ (length (nth 0 (backtrace-tests--backtrace-lines))) 2))
|
||||
(backtrace-backward-frame)
|
||||
(should (= start (point))))
|
||||
|
||||
;; Move backward from end of buffer.
|
||||
(goto-char (point-max))
|
||||
(backtrace-backward-frame)
|
||||
(let* ((last (format (car (last (backtrace-tests--backtrace-lines))) nil))
|
||||
(len (length last)))
|
||||
(should (string= (buffer-substring-no-properties (point) (+ (point) len))
|
||||
last)))
|
||||
|
||||
;; Move backward from start of line.
|
||||
(backtrace-backward-frame)
|
||||
(let* ((line (car (last (backtrace-tests--backtrace-lines) 2)))
|
||||
(len (length line)))
|
||||
(should (string= (buffer-substring-no-properties (point) (+ (point) len))
|
||||
line))))))
|
||||
|
||||
(ert-deftest backtrace-tests--forward-frame ()
|
||||
"`backtrace-forward-frame' moves forward to the start of a frame."
|
||||
(ert-with-test-buffer (:name "forward")
|
||||
(let* ((arg '(1 2 3))
|
||||
(results (concat backtrace-tests--header
|
||||
(backtrace-tests--result arg)))
|
||||
(first-line (nth 0 (backtrace-tests--backtrace-lines))))
|
||||
(backtrace-tests--make-backtrace arg)
|
||||
(setq backtrace-insert-header-function #'backtrace-tests--insert-header)
|
||||
(backtrace-print)
|
||||
(should (string= (backtrace-tests--get-substring (point-min) (point-max))
|
||||
results))
|
||||
;; Move forward from header.
|
||||
(goto-char (+ (point-min) (/ (length backtrace-tests--header) 2)))
|
||||
(backtrace-forward-frame)
|
||||
(should (string= (backtrace-tests--get-substring
|
||||
(point) (+ (point) (length first-line)))
|
||||
first-line))
|
||||
|
||||
(let ((start (point))
|
||||
(offset (/ (length first-line) 2))
|
||||
(second-line (nth 1 (backtrace-tests--backtrace-lines))))
|
||||
;; Move forward from start of first frame.
|
||||
(backtrace-forward-frame)
|
||||
(should (string= (backtrace-tests--get-substring
|
||||
(point) (+ (point) (length second-line)))
|
||||
second-line))
|
||||
;; Move forward from middle of first frame.
|
||||
(goto-char (+ start offset))
|
||||
(backtrace-forward-frame)
|
||||
(should (string= (backtrace-tests--get-substring
|
||||
(point) (+ (point) (length second-line)))
|
||||
second-line)))
|
||||
;; Try to move forward from middle of last frame.
|
||||
(goto-char (- (point-max)
|
||||
(/ 2 (length (car (last (backtrace-tests--backtrace-lines)))))))
|
||||
(should-error (backtrace-forward-frame))
|
||||
;; Try to move forward from end of buffer.
|
||||
(goto-char (point-max))
|
||||
(should-error (backtrace-forward-frame)))))
|
||||
|
||||
(ert-deftest backtrace-tests--pretty-print-and-collapse ()
|
||||
"Forms in backtrace frames can be pretty-printed and collapsed."
|
||||
(ert-with-test-buffer (:name "pp-and-collapse")
|
||||
(let* ((arg '(lambda (x) ; Quote this so it isn't made into a closure.
|
||||
(let ((number (1+ x)))
|
||||
(+ x number))))
|
||||
(header-string "Test header: ")
|
||||
(header (format "%s%s\n" header-string arg))
|
||||
(insert-header-function (lambda ()
|
||||
(insert header-string)
|
||||
(insert (backtrace-print-to-string arg))
|
||||
(insert "\n")))
|
||||
(results (concat header (backtrace-tests--result arg)))
|
||||
(last-line (format (nth (1- backtrace-tests--line-count)
|
||||
(backtrace-tests--backtrace-lines))
|
||||
arg))
|
||||
(last-line-locals (format (nth (1- (* 2 backtrace-tests--line-count))
|
||||
(backtrace-tests--backtrace-lines-with-locals))
|
||||
arg)))
|
||||
|
||||
(backtrace-tests--make-backtrace arg)
|
||||
(setq backtrace-insert-header-function insert-header-function)
|
||||
(backtrace-print)
|
||||
(should (string= (backtrace-tests--get-substring (point-min) (point-max))
|
||||
results))
|
||||
;; Check pp and collapse for the form in the header.
|
||||
(goto-char (point-min))
|
||||
(backtrace-tests--verify-pp-and-collapse header)
|
||||
;; Check pp and collapse for the last frame.
|
||||
(goto-char (point-max))
|
||||
(backtrace-backward-frame)
|
||||
(backtrace-tests--verify-pp-and-collapse last-line)
|
||||
;; Check pp and collapse for local variables in the last line.
|
||||
(goto-char (point-max))
|
||||
(backtrace-backward-frame)
|
||||
(backtrace-toggle-locals)
|
||||
(forward-line)
|
||||
(backtrace-tests--verify-pp-and-collapse last-line-locals))))
|
||||
|
||||
(defun backtrace-tests--verify-pp-and-collapse (line)
|
||||
"Verify that `backtrace-pretty-print' and `backtrace-collapse' work at point.
|
||||
Point should be at the beginning of a line, and LINE should be a
|
||||
string containing the text of the line at point. Assume that the
|
||||
line contains the strings \"lambda\" and \"number\"."
|
||||
(let ((pos (point)))
|
||||
(backtrace-pretty-print)
|
||||
;; Verify point is still at the start of the line.
|
||||
(should (= pos (point))))
|
||||
|
||||
;; Verify the form now spans multiple lines.
|
||||
(let ((pos (point)))
|
||||
(search-forward "number")
|
||||
(should-not (= pos (point-at-bol))))
|
||||
;; Collapse the form.
|
||||
(backtrace-collapse)
|
||||
;; Verify that the form is now back on one line,
|
||||
;; and that point is at the same place.
|
||||
(should (string= (backtrace-tests--get-substring
|
||||
(- (point) 6) (point)) "number"))
|
||||
(should-not (= (point) (point-at-bol)))
|
||||
(should (string= (backtrace-tests--get-substring
|
||||
(point-at-bol) (1+ (point-at-eol)))
|
||||
line)))
|
||||
|
||||
(ert-deftest backtrace-tests--print-circle ()
|
||||
"Backtrace buffers can toggle `print-circle' syntax."
|
||||
(ert-with-test-buffer (:name "print-circle")
|
||||
(let* ((print-circle nil)
|
||||
(arg (let ((val (make-list 5 'a))) (nconc val val) val))
|
||||
(results (backtrace-tests--make-regexp
|
||||
(backtrace-tests--result arg)))
|
||||
(results-circle (regexp-quote (let ((print-circle t))
|
||||
(backtrace-tests--result arg))))
|
||||
(last-frame (backtrace-tests--make-regexp
|
||||
(format (nth (1- backtrace-tests--line-count)
|
||||
(backtrace-tests--backtrace-lines))
|
||||
arg)))
|
||||
(last-frame-circle (regexp-quote
|
||||
(let ((print-circle t))
|
||||
(format (nth (1- backtrace-tests--line-count)
|
||||
(backtrace-tests--backtrace-lines))
|
||||
arg)))))
|
||||
(backtrace-tests--make-backtrace arg)
|
||||
(backtrace-print)
|
||||
(should (string-match-p results
|
||||
(backtrace-tests--get-substring (point-min) (point-max))))
|
||||
;; Go to the last frame.
|
||||
(goto-char (point-max))
|
||||
(forward-line -1)
|
||||
;; Turn on print-circle for that frame.
|
||||
(backtrace-toggle-print-circle)
|
||||
(should (string-match-p last-frame-circle
|
||||
(backtrace-tests--get-substring (point) (point-max))))
|
||||
;; Turn off print-circle for the frame.
|
||||
(backtrace-toggle-print-circle)
|
||||
(should (string-match-p last-frame
|
||||
(backtrace-tests--get-substring (point) (point-max))))
|
||||
(should (string-match-p results
|
||||
(backtrace-tests--get-substring (point-min) (point-max))))
|
||||
;; Turn print-circle on for the buffer.
|
||||
(backtrace-toggle-print-circle '(4))
|
||||
(should (string-match-p last-frame-circle
|
||||
(backtrace-tests--get-substring (point) (point-max))))
|
||||
(should (string-match-p results-circle
|
||||
(backtrace-tests--get-substring (point-min) (point-max))))
|
||||
;; Turn print-circle off.
|
||||
(backtrace-toggle-print-circle '(4))
|
||||
(should (string-match-p last-frame
|
||||
(backtrace-tests--get-substring
|
||||
(point) (+ (point) (length last-frame)))))
|
||||
(should (string-match-p results
|
||||
(backtrace-tests--get-substring (point-min) (point-max)))))))
|
||||
|
||||
(defun backtrace-tests--make-regexp (str)
|
||||
"Make regexp from STR for `backtrace-tests--print-circle'.
|
||||
Used for results of printing circular objects without
|
||||
`print-circle' on. Look for #n in string STR where n is any
|
||||
digit and replace with #[0-9]."
|
||||
(let ((regexp (regexp-quote str)))
|
||||
(with-temp-buffer
|
||||
(insert regexp)
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "#[0-9]" nil t)
|
||||
(replace-match "#[0-9]")))
|
||||
(buffer-string)))
|
||||
|
||||
(ert-deftest backtrace-tests--expand-ellipsis ()
|
||||
"Backtrace buffers ellipsify large forms and can expand the ellipses."
|
||||
;; make a backtrace with an ellipsis
|
||||
;; expand the ellipsis
|
||||
(ert-with-test-buffer (:name "variables")
|
||||
(let* ((print-level nil)
|
||||
(print-length nil)
|
||||
(arg (let ((long (make-list 100 'a))
|
||||
(deep '(0 (1 (2 (3 (4 (5 (6 (7 (8 (9))))))))))))
|
||||
(setf (nth 1 long) deep)
|
||||
long))
|
||||
(results (backtrace-tests--result arg)))
|
||||
(backtrace-tests--make-backtrace arg)
|
||||
(backtrace-print)
|
||||
|
||||
;; There should be two ellipses. Find and expand them.
|
||||
(goto-char (point-min))
|
||||
(search-forward "...")
|
||||
(backward-char)
|
||||
(push-button)
|
||||
(search-forward "...")
|
||||
(backward-char)
|
||||
(push-button)
|
||||
|
||||
(should (string= (backtrace-tests--get-substring (point-min) (point-max))
|
||||
results)))))
|
||||
|
||||
(ert-deftest backtrace-tests--to-string ()
|
||||
(should (string= (backtrace-to-string backtrace-tests--frames)
|
||||
" backtrace-get-frames(nil)
|
||||
(setq backtrace-tests--frames (backtrace-get-frames nil))
|
||||
backtrace-tests--func1(\"string\" 0)
|
||||
(list foo (backtrace-tests--func2 arg) (backtrace-tests--func1 arg 0))
|
||||
(let ((foo (list 'a arg 'b))) (list foo (backtrace-tests--func2 arg) (backtrace-tests--func1 arg 0)))
|
||||
backtrace-tests--func3(\"string\")
|
||||
backtrace-tests--create-backtrace-frames()
|
||||
")))
|
||||
"Backtraces can be produced as strings."
|
||||
(let ((frames (ert-with-test-buffer (:name nil)
|
||||
(backtrace-tests--make-backtrace "string")
|
||||
backtrace-frames)))
|
||||
(should (string= (backtrace-to-string frames)
|
||||
(backtrace-tests--result "string")))))
|
||||
|
||||
(defun backtrace-tests--get-substring (beg end)
|
||||
"Return the visible text between BEG and END.
|
||||
Strip the string properties because it makes failed test results
|
||||
easier to read."
|
||||
(substring-no-properties (filter-buffer-substring beg end)))
|
||||
|
||||
(provide 'backtrace-tests)
|
||||
|
||||
;; These tests expect to see non-byte compiled stack frames.
|
||||
;; Local Variables:
|
||||
;; no-byte-compile: t
|
||||
;; End:
|
||||
|
||||
;;; backtrace-tests.el ends here
|
||||
|
||||
Loading…
Reference in New Issue
Block a user