Add more tests for backtrace-mode

Change the method of generating sample backtraces 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): Deleted.
(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): Deleted.
(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.

1 files changed, 352 insertions, 47 deletions

diff --git a/test/lisp/emacs-lisp/backtrace-tests.el b/test/lisp/emacs-lisp/backtrace-tests.el
index 75da468494b..a072c7c25a6 100644
--- a/test/lisp/emacs-lisp/backtrace-tests.el
+++ b/test/lisp/emacs-lisp/backtrace-tests.el
@@ -1,4 +1,4 @@
-;;; backtrace-tests.el --- Tests for emacs-lisp/backtrace.el  -*- lexical-binding: t; -*-
+;;; backtrace-tests.el --- Tests for backtrace.el  -*- 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 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 last-frame-circle
+                            (backtrace-tests--get-substring (point) (point-max))))
+      ;; Turn off print-circle for the frame.
+      (backtrace-toggle-print-circle)
+      (should (string-match last-frame
+                            (backtrace-tests--get-substring (point) (point-max))))
+      (should (string-match results
+                            (backtrace-tests--get-substring (point-min) (point-max))))
+      ;; Turn print-circle on for the buffer.
+      (backtrace-toggle-print-circle '(4))
+      (should (string-match last-frame-circle
+                            (backtrace-tests--get-substring (point) (point-max))))
+      (should (string-match results-circle
+                            (backtrace-tests--get-substring (point-min) (point-max))))
+      ;; Turn print-circle off.
+      (backtrace-toggle-print-circle '(4))
+      (should (string-match last-frame
+                            (backtrace-tests--get-substring
+                             (point) (+ (point) (length last-frame)))))
+      (should (string-match 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")))))
 
-(provide 'backtrace-tests)
+(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)))
 
-;; These tests expect to see non-byte compiled stack frames.
-;; Local Variables:
-;; no-byte-compile: t
-;; End:
+(provide 'backtrace-tests)
 
 ;;; backtrace-tests.el ends here