Merge branch 'scratch/backtrace-mode'

5 files changed, 628 insertions, 8 deletions

diff --git a/test/lisp/emacs-lisp/backtrace-tests.el b/test/lisp/emacs-lisp/backtrace-tests.el
new file mode 100644
index 00000000000..edd45c770c5
--- /dev/null
+++ b/test/lisp/emacs-lisp/backtrace-tests.el
@@ -0,0 +1,436 @@
+;;; backtrace-tests.el --- Tests for backtraces -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2018 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/>.
+
+;;; Code:
+
+(require 'backtrace)
+(require 'ert)
+(require 'ert-x)
+(require 'seq)
+
+;; Delay evaluation of the backtrace-creating functions until
+;; load so that the backtraces are the same whether this file
+;; is compiled or not.
+
+(eval-and-compile
+  (defconst backtrace-tests--uncompiled-functions
+    '(progn
+       (defun backtrace-tests--make-backtrace (arg)
+         (backtrace-tests--setup-buffer))
+
+       (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))))
+
+  (eval backtrace-tests--uncompiled-functions))
+
+(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")))
+
+(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 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--single-and-multi-line ()
+  "Forms in backtrace frames can be on a single line or on multiple lines."
+  (ert-with-test-buffer (:name "single-multi-line")
+    (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-single-and-multi-line header)
+      ;; Check pp and collapse for the last frame.
+      (goto-char (point-max))
+      (backtrace-backward-frame)
+      (backtrace-tests--verify-single-and-multi-line 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-single-and-multi-line last-line-locals))))
+
+(defun backtrace-tests--verify-single-and-multi-line (line)
+  "Verify that `backtrace-single-line' and `backtrace-multi-line' 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-multi-line)
+    ;; 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-single-line)
+  ;; 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 as buttons which 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)
+           (backtrace-line-length 300)
+           (arg (make-list 40 (make-string 10 ?a)))
+           (results (backtrace-tests--result arg)))
+      (backtrace-tests--make-backtrace arg)
+      (backtrace-print)
+
+      ;; There should be an ellipsis. Find and expand it.
+      (goto-char (point-min))
+      (search-forward "...")
+      (backward-char)
+      (push-button)
+
+      (should (string= (backtrace-tests--get-substring (point-min) (point-max))
+                       results)))))
+
+(ert-deftest backtrace-tests--expand-ellipses ()
+  "Backtrace buffers ellipsify large forms and can expand the ellipses."
+  (ert-with-test-buffer (:name "variables")
+    (let* ((print-level nil)
+           (print-length nil)
+           (backtrace-line-length 300)
+           (arg (let ((outer (make-list 40 (make-string 10 ?a)))
+                      (nested (make-list 40 (make-string 10 ?b))))
+                  (setf (nth 39 nested) (make-list 40 (make-string 10 ?c)))
+                  (setf (nth 39 outer) nested)
+                  outer))
+           (results (backtrace-tests--result-with-locals arg)))
+
+      ;; Make a backtrace with local variables visible.
+      (backtrace-tests--make-backtrace arg)
+      (backtrace-print)
+      (backtrace-toggle-locals '(4))
+
+      ;; There should be two ellipses.
+      (goto-char (point-min))
+      (should (search-forward "..."))
+      (should (search-forward "..."))
+      (should-error (search-forward "..."))
+
+      ;; Expanding the last frame without argument should expand both
+      ;; ellipses, but the expansions will contain one ellipsis each.
+      (let ((buffer-len (- (point-max) (point-min))))
+        (goto-char (point-max))
+        (backtrace-backward-frame)
+        (backtrace-expand-ellipses)
+        (should (> (- (point-max) (point-min)) buffer-len))
+        (goto-char (point-min))
+        (should (search-forward "..."))
+        (should (search-forward "..."))
+        (should-error (search-forward "...")))
+
+      ;; Expanding with argument should remove all ellipses.
+      (goto-char (point-max))
+      (backtrace-backward-frame)
+      (backtrace-expand-ellipses '(4))
+      (goto-char (point-min))
+
+      (should-error (search-forward "..."))
+      (should (string= (backtrace-tests--get-substring (point-min) (point-max))
+                       results)))))
+
+
+(ert-deftest backtrace-tests--to-string ()
+  "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)
+
+;;; backtrace-tests.el ends here
diff --git a/test/lisp/emacs-lisp/cl-print-tests.el b/test/lisp/emacs-lisp/cl-print-tests.el
index 404d323d0c1..a469b5526c0 100644
--- a/test/lisp/emacs-lisp/cl-print-tests.el
+++ b/test/lisp/emacs-lisp/cl-print-tests.el
@@ -56,19 +56,30 @@
   (let ((long-list (make-list 5 'a))
         (long-vec (make-vector 5 'b))
         (long-struct (cl-print-tests-con))
+        (long-string (make-string 5 ?a))
         (print-length 4))
     (should (equal "(a a a a ...)" (cl-prin1-to-string long-list)))
     (should (equal "[b b b b ...]" (cl-prin1-to-string long-vec)))
     (should (equal "#s(cl-print-tests-struct :a nil :b nil :c nil :d nil ...)"
-                   (cl-prin1-to-string long-struct)))))
+                   (cl-prin1-to-string long-struct)))
+    (should (equal "\"aaaa...\"" (cl-prin1-to-string long-string)))))
 
 (ert-deftest cl-print-tests-4 ()
   "CL printing observes `print-level'."
-  (let ((deep-list '(a (b (c (d (e))))))
-        (deep-struct (cl-print-tests-con))
-        (print-level 4))
+  (let* ((deep-list '(a (b (c (d (e))))))
+         (buried-vector '(a (b (c (d [e])))))
+         (deep-struct (cl-print-tests-con))
+         (buried-struct `(a (b (c (d ,deep-struct)))))
+         (buried-string '(a (b (c (d #("hello" 0 5 (cl-print-test t)))))))
+         (buried-simple-string '(a (b (c (d "hello")))))
+         (print-level 4))
     (setf (cl-print-tests-struct-a deep-struct) deep-list)
     (should (equal "(a (b (c (d ...))))" (cl-prin1-to-string deep-list)))
+    (should (equal "(a (b (c (d ...))))" (cl-prin1-to-string buried-vector)))
+    (should (equal "(a (b (c (d ...))))" (cl-prin1-to-string buried-struct)))
+    (should (equal "(a (b (c (d ...))))" (cl-prin1-to-string buried-string)))
+    (should (equal "(a (b (c (d \"hello\"))))"
+                   (cl-prin1-to-string buried-simple-string)))
     (should (equal "#s(cl-print-tests-struct :a (a (b (c ...))) :b nil :c nil :d nil :e nil)"
                    (cl-prin1-to-string deep-struct)))))
 
@@ -82,6 +93,129 @@
       (should (equal "((quote a) (function b) (\\` ((\\, c) (\\,@ d))))"
                      (cl-prin1-to-string quoted-stuff))))))
 
+(ert-deftest cl-print-tests-strings ()
+  "CL printing prints strings and propertized strings."
+  (let* ((str1 "abcdefghij")
+         (str2 #("abcdefghij" 3 6 (bold t) 7 9 (italic t)))
+         (str3 #("abcdefghij" 0 10 (test t)))
+         (obj '(a b))
+         ;; Since the byte compiler reuses string literals,
+         ;; and the put-text-property call is destructive, use
+         ;; copy-sequence to make a new string.
+         (str4 (copy-sequence "abcdefghij")))
+    (put-text-property 0 5 'test obj str4)
+    (put-text-property 7 10 'test obj str4)
+
+    (should (equal "\"abcdefghij\"" (cl-prin1-to-string str1)))
+    (should (equal "#(\"abcdefghij\" 3 6 (bold t) 7 9 (italic t))"
+                   (cl-prin1-to-string str2)))
+    (should (equal "#(\"abcdefghij\" 0 10 (test t))"
+                   (cl-prin1-to-string str3)))
+    (let ((print-circle nil))
+      (should
+       (equal
+        "#(\"abcdefghij\" 0 5 (test (a b)) 7 10 (test (a b)))"
+        (cl-prin1-to-string str4))))
+    (let ((print-circle t))
+      (should
+       (equal
+        "#(\"abcdefghij\" 0 5 (test #1=(a b)) 7 10 (test #1#))"
+        (cl-prin1-to-string str4))))))
+
+(ert-deftest cl-print-tests-ellipsis-cons ()
+  "Ellipsis expansion works in conses."
+  (let ((print-length 4)
+        (print-level 3))
+    (cl-print-tests-check-ellipsis-expansion
+     '(0 1 2 3 4 5) "(0 1 2 3 ...)" "4 5")
+    (cl-print-tests-check-ellipsis-expansion
+     '(0 1 2 3 4 5 6 7 8 9) "(0 1 2 3 ...)" "4 5 6 7 ...")
+    (cl-print-tests-check-ellipsis-expansion
+     '(a (b (c (d (e))))) "(a (b (c ...)))" "(d (e))")
+    (cl-print-tests-check-ellipsis-expansion
+     (let ((x (make-list 6 'b)))
+       (setf (nthcdr 6 x) 'c)
+       x)
+     "(b b b b ...)" "b b . c")))
+
+(ert-deftest cl-print-tests-ellipsis-vector ()
+  "Ellipsis expansion works in vectors."
+  (let ((print-length 4)
+        (print-level 3))
+    (cl-print-tests-check-ellipsis-expansion
+     [0 1 2 3 4 5] "[0 1 2 3 ...]" "4 5")
+    (cl-print-tests-check-ellipsis-expansion
+     [0 1 2 3 4 5 6 7 8 9] "[0 1 2 3 ...]" "4 5 6 7 ...")
+    (cl-print-tests-check-ellipsis-expansion
+     [a [b [c [d [e]]]]] "[a [b [c ...]]]" "[d [e]]")))
+
+(ert-deftest cl-print-tests-ellipsis-string ()
+  "Ellipsis expansion works in strings."
+  (let ((print-length 4)
+        (print-level 3))
+    (cl-print-tests-check-ellipsis-expansion
+     "abcdefg" "\"abcd...\"" "efg")
+    (cl-print-tests-check-ellipsis-expansion
+     "abcdefghijk" "\"abcd...\"" "efgh...")
+    (cl-print-tests-check-ellipsis-expansion
+     '(1 (2 (3 #("abcde" 0 5 (test t)))))
+     "(1 (2 (3 ...)))" "#(\"abcd...\" 0 5 (test t))")
+    (cl-print-tests-check-ellipsis-expansion
+     #("abcd" 0 1 (bold t) 1 2 (invisible t) 3 4 (italic t))
+     "#(\"abcd\" 0 1 (bold t) ...)" "1 2 (invisible t) ...")))
+
+(ert-deftest cl-print-tests-ellipsis-struct ()
+  "Ellipsis expansion works in structures."
+  (let ((print-length 4)
+        (print-level 3)
+        (struct (cl-print-tests-con)))
+    (cl-print-tests-check-ellipsis-expansion
+     struct "#s(cl-print-tests-struct :a nil :b nil :c nil :d nil ...)" ":e nil")
+    (let ((print-length 2))
+      (cl-print-tests-check-ellipsis-expansion
+       struct "#s(cl-print-tests-struct :a nil :b nil ...)" ":c nil :d nil ..."))
+    (cl-print-tests-check-ellipsis-expansion
+     `(a (b (c ,struct)))
+     "(a (b (c ...)))"
+     "#s(cl-print-tests-struct :a nil :b nil :c nil :d nil ...)")))
+
+(ert-deftest cl-print-tests-ellipsis-circular ()
+  "Ellipsis expansion works with circular objects."
+  (let ((wide-obj (list 0 1 2 3 4))
+        (deep-obj `(0 (1 (2 (3 (4))))))
+        (print-length 4)
+        (print-level 3))
+    (setf (nth 4 wide-obj) wide-obj)
+    (setf (car (cadadr (cadadr deep-obj))) deep-obj)
+    (let ((print-circle nil))
+      (cl-print-tests-check-ellipsis-expansion-rx
+       wide-obj (regexp-quote "(0 1 2 3 ...)") "\\`#[0-9]\\'")
+      (cl-print-tests-check-ellipsis-expansion-rx
+       deep-obj (regexp-quote "(0 (1 (2 ...)))") "\\`(3 (#[0-9]))\\'"))
+    (let ((print-circle t))
+      (cl-print-tests-check-ellipsis-expansion
+       wide-obj "#1=(0 1 2 3 ...)" "#1#")
+      (cl-print-tests-check-ellipsis-expansion
+       deep-obj "#1=(0 (1 (2 ...)))" "(3 (#1#))"))))
+
+(defun cl-print-tests-check-ellipsis-expansion (obj expected expanded)
+  (let* ((result (cl-prin1-to-string obj))
+         (pos (next-single-property-change 0 'cl-print-ellipsis result))
+         value)
+    (should pos)
+    (setq value (get-text-property pos 'cl-print-ellipsis result))
+    (should (equal expected result))
+    (should (equal expanded (with-output-to-string (cl-print-expand-ellipsis
+                                                    value nil))))))
+
+(defun cl-print-tests-check-ellipsis-expansion-rx (obj expected expanded)
+  (let* ((result (cl-prin1-to-string obj))
+         (pos (next-single-property-change 0 'cl-print-ellipsis result))
+         (value (get-text-property pos 'cl-print-ellipsis result)))
+    (should (string-match expected result))
+    (should (string-match expanded (with-output-to-string
+                                     (cl-print-expand-ellipsis value nil))))))
+
 (ert-deftest cl-print-circle ()
   (let ((x '(#1=(a . #1#) #1#)))
     (let ((print-circle nil))
@@ -99,5 +233,41 @@
     (let ((print-circle t))
       (should (equal "(0 . #1=(0 . #1#))" (cl-prin1-to-string x))))))
 
+(ert-deftest cl-print-tests-print-to-string-with-limit ()
+  (let* ((thing10 (make-list 10 'a))
+         (thing100 (make-list 100 'a))
+         (thing10x10 (make-list 10 thing10))
+         (nested-thing (let ((val 'a))
+                         (dotimes (_i 20)
+                           (setq val (list val)))
+                         val))
+         ;; Make a consistent environment for this test.
+         (print-circle nil)
+         (print-level nil)
+         (print-length nil))
+
+    ;; Print something that fits in the space given.
+    (should (string= (cl-prin1-to-string thing10)
+                     (cl-print-to-string-with-limit #'cl-prin1 thing10 100)))
+
+    ;; Print something which needs to be abbreviated and which can be.
+    (should (< (length (cl-print-to-string-with-limit #'cl-prin1 thing100 100))
+               100
+               (length (cl-prin1-to-string thing100))))
+
+    ;; Print something resistant to easy abbreviation.
+    (should (string= (cl-prin1-to-string thing10x10)
+                     (cl-print-to-string-with-limit #'cl-prin1 thing10x10 100)))
+
+    ;; Print something which should be abbreviated even if the limit is large.
+    (should (< (length (cl-print-to-string-with-limit #'cl-prin1 nested-thing 1000))
+               (length (cl-prin1-to-string nested-thing))))
+
+    ;; Print with no limits.
+    (dolist (thing (list thing10 thing100 thing10x10 nested-thing))
+      (let ((rep (cl-prin1-to-string thing)))
+        (should (string= rep (cl-print-to-string-with-limit #'cl-prin1 thing 0)))
+        (should (string= rep (cl-print-to-string-with-limit #'cl-prin1 thing nil)))))))
+
 
 ;;; cl-print-tests.el ends here.
diff --git a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el
index f3fc78d4e12..97dead057a9 100644
--- a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el
+++ b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el
@@ -41,7 +41,7 @@
 (defun edebug-test-code-range (num)
   !start!(let ((index 0)
         (result nil))
-    (while (< index num)!test!
+    (while !lt!(< index num)!test!
       (push index result)!loop!
       (cl-incf index))!end-loop!
     (nreverse result)))
diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el
index 7d780edf285..7880aaf95bc 100644
--- a/test/lisp/emacs-lisp/edebug-tests.el
+++ b/test/lisp/emacs-lisp/edebug-tests.el
@@ -432,9 +432,11 @@ test and possibly others should be updated."
     (verify-keybinding "P" 'edebug-view-outside) ;; same as v
     (verify-keybinding "W" 'edebug-toggle-save-windows)
     (verify-keybinding "?" 'edebug-help)
-    (verify-keybinding "d" 'edebug-backtrace)
+    (verify-keybinding "d" 'edebug-pop-to-backtrace)
     (verify-keybinding "-" 'negative-argument)
-    (verify-keybinding "=" 'edebug-temp-display-freq-count)))
+    (verify-keybinding "=" 'edebug-temp-display-freq-count)
+    (should (eq (lookup-key backtrace-mode-map "n") 'backtrace-forward-frame))
+    (should (eq (lookup-key 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."
@@ -924,5 +926,17 @@ test and possibly others should be updated."
     "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))))))
+
 (provide 'edebug-tests)
 ;;; edebug-tests.el ends here
diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el
index cb957bd9fd6..1fe5b79ef36 100644
--- a/test/lisp/emacs-lisp/ert-tests.el
+++ b/test/lisp/emacs-lisp/ert-tests.el
@@ -376,7 +376,7 @@ This macro is used to test if macroexpansion in `should' works."
          (test (make-ert-test :body test-body))
          (result (ert-run-test test)))
     (should (ert-test-failed-p result))
-    (should (eq (nth 1 (car (ert-test-failed-backtrace result)))
+    (should (eq (backtrace-frame-fun (car (ert-test-failed-backtrace result)))
                 'signal))))
 
 (ert-deftest ert-test-messages ()