Move backtrace to ELisp using a new mapbacktrace primitive

* src/eval.c (get_backtrace_starting_at, backtrace_frame_apply)
(Fmapbacktrace, Fbacktrace_frame_internal): New functions.
(get_backtrace_frame, Fbacktrace_debug): Use `get_backtrace_starting_at'.

* lisp/subr.el (backtrace--print-frame): New function.
(backtrace): Reimplement using `backtrace--print-frame' and `mapbacktrace'.
(backtrace-frame): Reimplement using `backtrace-frame--internal'.

* lisp/emacs-lisp/debug.el (debugger-setup-buffer): Pass a base to
`mapbacktrace' instead of searching for "(debug" in the output of
`backtrace'.

* test/lisp/subr-tests.el (subr-test-backtrace-simple-tests)
(subr-test-backtrace-integration-test): New tests.

* doc/lispref/debugging.texi (Internals of Debugger): Document
`mapbacktrace' and missing argument BASE of `backtrace-frame'.

1 files changed, 47 insertions, 0 deletions

diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index ce212903c9d..82a70ca072b 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -224,5 +224,52 @@
               (error-message-string (should-error (version-to-list "beta22_8alpha3")))
               "Invalid version syntax: `beta22_8alpha3' (must start with a number)"))))
 
+(defun subr-test--backtrace-frames-with-backtrace-frame (base)
+  "Reference implementation of `backtrace-frames'."
+  (let ((idx 0)
+        (frame nil)
+        (frames nil))
+    (while (setq frame (backtrace-frame idx base))
+      (push frame frames)
+      (setq idx (1+ idx)))
+    (nreverse frames)))
+
+(defun subr-test--frames-2 (base)
+  (let ((_dummy nil))
+    (progn ;; Add a few frames to top of stack
+      (unwind-protect
+          (cons (mapcar (pcase-lambda (`(,evald ,func ,args ,_))
+                          `(,evald ,func ,@args))
+                        (backtrace-frames base))
+                (subr-test--backtrace-frames-with-backtrace-frame base))))))
+
+(defun subr-test--frames-1 (base)
+  (subr-test--frames-2 base))
+
+(ert-deftest subr-test-backtrace-simple-tests ()
+  "Test backtrace-related functions (simple tests).
+This exercises `backtrace-frame', and indirectly `mapbacktrace'."
+  ;; `mapbacktrace' returns nil
+  (should (equal (mapbacktrace #'ignore) nil))
+  ;; Unbound BASE is silently ignored
+  (let ((unbound (make-symbol "ub")))
+    (should (equal (backtrace-frame 0 unbound) nil))
+    (should (equal (mapbacktrace #'error unbound) nil)))
+  ;; First frame is backtrace-related function
+  (should (equal (backtrace-frame 0) '(t backtrace-frame 0)))
+  (should (equal (catch 'ret
+                   (mapbacktrace (lambda (&rest args) (throw 'ret args))))
+                 '(t mapbacktrace ((lambda (&rest args) (throw 'ret args))) nil)))
+  ;; Past-end NFRAMES is silently ignored
+  (should (equal (backtrace-frame most-positive-fixnum) nil)))
+
+(ert-deftest subr-test-backtrace-integration-test ()
+  "Test backtrace-related functions (integration test).
+This exercises `backtrace-frame', `backtrace-frames', and
+indirectly `mapbacktrace'."
+  ;; Compare two implementations of backtrace-frames
+  (let ((frame-lists (subr-test--frames-1 'subr-test--frames-2)))
+    (should (equal (car frame-lists) (cdr frame-lists)))))
+
 (provide 'subr-tests)
 ;;; subr-tests.el ends here