From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: =?UTF-8?Q?Cl=c3=a9ment_Pit--Claudel?= Newsgroups: gmane.emacs.devel Subject: Re: Lisp-friendly backtraces [was: Lispy backtraces] Date: Wed, 7 Dec 2016 03:27:17 -0500 Message-ID: References: <20160922231447.GA3833@odonien.localdomain> <98fbb582-3da4-bd83-a2e9-e341dd7f6140@gmail.com> <20160923075116.GA612@odonien.localdomain> <82e39377-f31b-698c-5a9a-343868686799@gmail.com> <20161202005226.GA4215@odonien.localdomain> <0a69afa7-e9e6-e75f-8e90-6438683db98d@gmail.com> <53ba4534-1ec3-4e4f-d929-1a72f79c1abe@gmail.com> <83mvgblniy.fsf@gnu.org> <143c480c-a9db-7053-4b70-175633197981@gmail.com> <83a8cbl94w.fsf@gnu.org> <233f14a0-7542-5d0c-d8da-209e7e5e54f7@gmail.com> <838trvkq72.fsf@gnu.org> <27574c57-658c-c87b-4ddc-b24f83e2867c@gmail.com> <81066f70-ceed-af88-43ce-c8baefde189a@gmail.com> <83twaijqes.fsf@gnu.org> <83vauwj39z.fsf@gnu.org> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: multipart/signed; micalg=pgp-sha256; protocol="application/pgp-signature"; boundary="4Lk7XNSvF5p7xhDuXIxD1OBmSqgCCtbMb" X-Trace: blaine.gmane.org 1481099296 17054 195.159.176.226 (7 Dec 2016 08:28:16 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Wed, 7 Dec 2016 08:28:16 +0000 (UTC) User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:45.0) Gecko/20100101 Thunderbird/45.5.1 Cc: emacs-devel@gnu.org To: Eli Zaretskii Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Wed Dec 07 09:28:11 2016 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1cEXaE-0003e1-RA for ged-emacs-devel@m.gmane.org; Wed, 07 Dec 2016 09:28:11 +0100 Original-Received: from localhost ([::1]:37024 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cEXaJ-0004J8-0A for ged-emacs-devel@m.gmane.org; Wed, 07 Dec 2016 03:28:15 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:39013) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cEXZe-0004J2-5b for emacs-devel@gnu.org; Wed, 07 Dec 2016 03:27:36 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1cEXZb-0007po-Vm for emacs-devel@gnu.org; Wed, 07 Dec 2016 03:27:34 -0500 Original-Received: from mout.kundenserver.de ([212.227.17.24]:59555) by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1cEXZW-0007o6-PH; Wed, 07 Dec 2016 03:27:27 -0500 Original-Received: from [18.189.106.208] ([18.189.106.208]) by mrelayeu.kundenserver.de (mreue103 [212.227.15.184]) with ESMTPSA (Nemesis) id 0Mh6vJ-1c10tp2ROb-00MM6S; Wed, 07 Dec 2016 09:27:24 +0100 In-Reply-To: <83vauwj39z.fsf@gnu.org> X-Provags-ID: V03:K0:YvkSLZjMeK1xbeA68jUIsNRatPYiRherGIMRoa51VlIE7cTH28u 5QGVWewQJhPUIqoKMLSYMNl32lwFTM9ESfIxJBoX5NV9KqfBzW8s0SlzvLHHjD5OTi0cax4 xwbjlrBm+muaulPg9oWYPsQ2jw2zsfw0fadhP/VynvaIq2KsgK6hchVWESf9N6ZUGUMwIwj CM0X55doAG1kgccLr9rdg== X-UI-Out-Filterresults: notjunk:1;V01:K0:MsI5QmXP2nc=:niF4Mz/FTh/y5DG3PIdQ+q jw6YomVdqRydPrpSRjMJugcT1uqnGrS2x7Hny9/QTr+wZksroo+9LfjV1nlYkUEg9+hyWq+hv fCkxWoODEzDbcIoLu7WX0DjJ7xHzyezQQx/S9boqRKXR3NQOJVfXASBxXlalXHPBZyKtIJPGk 9+SJbHhKSMWn6PusSLSkZvbO4WjCufqNwA7Ub5n0npU/CzFIyeIc0ZPLbaMN/KS14JF/IME8R j0sovFnfaFev9CyQgUGN1rsnUiKtttm8qTluw45zDCTknfaI+jHC2+Vft9lFpivi13uSEKYXs wDMARX5wchkC+CYdgPJMHChpF0ezunD3p18UWjCK2T5dHNzGSsCWVGbRAM1G4eJyqvZ/Mj4/m luWp8n5ME0dtx1J4fYVtDF3thNJxFCGWJsqVtkoaFV8665avLd8hZFwxVz4GkYLqRxW4aRX5v I34QZBBqZJNMgV7KiV35F84VF6ZT84G2K/QCdfCNS1ngG0awqhvxzWf4nKL+lWXjAUN4pvmL4 9e2Og7sRH7JzTj+28/hgr2aP0X0S49p+mzrtL3MNnNH8fdeOS5SVzpCOTlu+mfhpcxiUmmKqX OavKSUrfIIDi6tdElgBpsGoxSsb/7488b/+VJ3UbIYW0jL+rRsm8KnKDareh1xzS8YAc8ogqR 045GZKEpsEczJfwBLoFOC9GaodZCDINBAxWV9hmfqWQ6t1CXoxxbCJ1PtrqXLMXoxcAo= X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] [fuzzy] X-Received-From: 212.227.17.24 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.21 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.org gmane.emacs.devel:210103 Archived-At: This is an OpenPGP/MIME signed message (RFC 4880 and 3156) --4Lk7XNSvF5p7xhDuXIxD1OBmSqgCCtbMb Content-Type: multipart/mixed; boundary="LhxtXlweULhsKHV1xm110FiSxFuSdQtNU"; protected-headers="v1" From: =?UTF-8?Q?Cl=c3=a9ment_Pit--Claudel?= To: Eli Zaretskii Cc: emacs-devel@gnu.org Message-ID: Subject: Re: Lisp-friendly backtraces [was: Lispy backtraces] References: <20160922231447.GA3833@odonien.localdomain> <98fbb582-3da4-bd83-a2e9-e341dd7f6140@gmail.com> <20160923075116.GA612@odonien.localdomain> <82e39377-f31b-698c-5a9a-343868686799@gmail.com> <20161202005226.GA4215@odonien.localdomain> <0a69afa7-e9e6-e75f-8e90-6438683db98d@gmail.com> <53ba4534-1ec3-4e4f-d929-1a72f79c1abe@gmail.com> <83mvgblniy.fsf@gnu.org> <143c480c-a9db-7053-4b70-175633197981@gmail.com> <83a8cbl94w.fsf@gnu.org> <233f14a0-7542-5d0c-d8da-209e7e5e54f7@gmail.com> <838trvkq72.fsf@gnu.org> <27574c57-658c-c87b-4ddc-b24f83e2867c@gmail.com> <81066f70-ceed-af88-43ce-c8baefde189a@gmail.com> <83twaijqes.fsf@gnu.org> <83vauwj39z.fsf@gnu.org> In-Reply-To: <83vauwj39z.fsf@gnu.org> --LhxtXlweULhsKHV1xm110FiSxFuSdQtNU Content-Type: multipart/mixed; boundary="------------9F630B155F6BD35DD7A092CE" This is a multi-part message in MIME format. --------------9F630B155F6BD35DD7A092CE Content-Type: text/plain; charset=windows-1252 Content-Transfer-Encoding: quoted-printable On 2016-12-06 13:55, Eli Zaretskii wrote: > [=85] > Otherwise, LGTM. Thanks a lot for the review! I've attached an updated patch, which I'll t= o master in a few days if no one objects :) Cl=E9ment. --------------9F630B155F6BD35DD7A092CE Content-Type: text/x-diff; name="0001-Move-backtrace-to-ELisp-using-a-new-mapbacktrace-pri.patch" Content-Transfer-Encoding: quoted-printable Content-Disposition: attachment; filename*0="0001-Move-backtrace-to-ELisp-using-a-new-mapbacktrace-pri.pa"; filename*1="tch" =46rom 0a525bc06b992c2995dd8f5853f9485588a2bf88 Mon Sep 17 00:00:00 2001 From: =3D?UTF-8?q?Cl=3DC3=3DA9ment=3D20Pit--Claudel?=3D Date: Mon, 5 Dec 2016 00:52:14 -0500 Subject: [PATCH] Move backtrace to ELisp using a new mapbacktrace primiti= ve * 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'. --- doc/lispref/debugging.texi | 23 ++++++- etc/NEWS | 4 ++ lisp/emacs-lisp/debug.el | 11 ++-- lisp/subr.el | 45 +++++++++++++ src/eval.c | 157 ++++++++++++++++++++-------------------= ------ test/lisp/subr-tests.el | 47 ++++++++++++++ 6 files changed, 192 insertions(+), 95 deletions(-) diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi index c80b0f9..8fb663d 100644 --- a/doc/lispref/debugging.texi +++ b/doc/lispref/debugging.texi @@ -727,7 +727,7 @@ Internals of Debugger This variable is obsolete and will be removed in future versions. @end defvar =20 -@defun backtrace-frame frame-number +@defun backtrace-frame frame-number &optional base The function @code{backtrace-frame} is intended for use in Lisp debuggers. It returns information about what computation is happening in the stack frame @var{frame-number} levels down. @@ -744,10 +744,31 @@ Internals of Debugger case of a macro call. If the function has a @code{&rest} argument, that= is represented as the tail of the list @var{arg-values}. =20 +If @var{base} is specified, @var{frame-number} counts relative to +the topmost frame whose @var{function} is @var{base}. + If @var{frame-number} is out of range, @code{backtrace-frame} returns @code{nil}. @end defun =20 +@defun mapbacktrace function &optional base +The function @code{mapbacktrace} calls @var{function} once for each +frame in the backtrace, starting at the first frame whose function is +@var{base} (or from the top if @var{base} is omitted or @code{nil}). + +@var{function} is called with four arguments: @var{evald}, @var{func}, +@var{args}, and @var{flags}. + +If a frame has not evaluated its arguments yet or is a special form, +@var{evald} is @code{nil} and @var{args} is a list of forms. + +If a frame has evaluated its arguments and called its function +already, @var{evald} is @code{t} and @var{args} is a list of values. +@var{flags} is a plist of properties of the current frame: currently, +the only supported property is @code{:debug-on-exit}, which is +@code{t} if the stack frame's @code{debug-on-exit} flag is set. +@end defun + @include edebug.texi =20 @node Syntax Errors diff --git a/etc/NEWS b/etc/NEWS index a62668a..72bef06 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -74,6 +74,10 @@ for '--daemon'. * Changes in Emacs 26.1 =20 +++ +** The new function 'mapbacktrace' applies a function to all frames of +the current stack trace. + ++++ ** The new function 'file-name-case-insensitive-p' tests whether a given file is on a case-insensitive filesystem. =20 diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 5430b72..5a4b097 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -274,15 +274,14 @@ debugger-setup-buffer (let ((standard-output (current-buffer)) (print-escape-newlines t) (print-level 8) - (print-length 50)) - (backtrace)) + (print-length 50)) + ;; FIXME the debugger could pass a custom callback to mapbacktrace + ;; instead of manipulating printed results. + (mapbacktrace #'backtrace--print-frame 'debug)) (goto-char (point-min)) (delete-region (point) (progn - (search-forward (if debugger-stack-frame-as-list - "\n (debug " - "\n debug(")) - (forward-line (if (eq (car args) 'debug) + (forward-line (if (eq (car args) 'debug) ;; Remove debug--implement-debug-on= -entry ;; and the advice's `apply' frame. 3 diff --git a/lisp/subr.el b/lisp/subr.el index 5da5bf8..6ab1d5f 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -4333,6 +4333,51 @@ define-mail-user-agent (put symbol 'sendfunc sendfunc) (put symbol 'abortfunc (or abortfunc 'kill-buffer)) (put symbol 'hookvar (or hookvar 'mail-send-hook))) + +=0C +(defun backtrace--print-frame (evald func args flags) + "Print a trace of a single stack frame to `standard-output'. +EVALD, FUNC, ARGS, FLAGS are as in `mapbacktrace'." + (princ (if (plist-get flags :debug-on-exit) "* " " ")) + (cond + ((and evald (not debugger-stack-frame-as-list)) + (prin1 func) + (if args (prin1 args) (princ "()"))) + (t + (prin1 (cons func args)))) + (princ "\n")) + +(defun backtrace () + "Print a trace of Lisp function calls currently active. +Output stream used is value of `standard-output'." + (let ((print-level (or print-level 8))) + (mapbacktrace #'backtrace--print-frame 'backtrace))) + +(defun backtrace-frames (&optional base) + "Collect all frames of current backtrace into a list. +If non-nil, BASE should be a function, and frames before its +nearest activation frames are discarded." + (let ((frames nil)) + (mapbacktrace (lambda (&rest frame) (push frame frames)) + (or base 'backtrace-frames)) + (nreverse frames))) + +(defun backtrace-frame (nframes &optional base) + "Return the function and arguments NFRAMES up from current execution p= oint. +If non-nil, BASE should be a function, and NFRAMES counts from its +nearest activation frame. +If the frame has not evaluated the arguments yet (or is a special form),= +the value is (nil FUNCTION ARG-FORMS...). +If the frame has evaluated its arguments and called its function already= , +the value is (t FUNCTION ARG-VALUES...). +A &rest arg is represented as the tail of the list ARG-VALUES. +FUNCTION is whatever was supplied as car of evaluated list, +or a lambda expression for macro calls. +If NFRAMES is more than the number of frames, the value is nil." + (backtrace-frame--internal + (lambda (evald func args _) `(,evald ,func ,@args)) + nframes (or base 'backtrace-frame))) + =0C (defvar called-interactively-p-functions nil "Special hook called to skip special frames in `called-interactively-p= '. diff --git a/src/eval.c b/src/eval.c index 724f001..929b942 100644 --- a/src/eval.c +++ b/src/eval.c @@ -3401,87 +3401,29 @@ context where binding is lexical by default. */)= } =20 =0C -DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0, - doc: /* Set the debug-on-exit flag of eval frame LEVEL levels dow= n to FLAG. -The debugger is entered when that frame exits, if the flag is non-nil. = */) - (Lisp_Object level, Lisp_Object flag) -{ - union specbinding *pdl =3D backtrace_top (); - register EMACS_INT i; - - CHECK_NUMBER (level); - - for (i =3D 0; backtrace_p (pdl) && i < XINT (level); i++) - pdl =3D backtrace_next (pdl); - - if (backtrace_p (pdl)) - set_backtrace_debug_on_exit (pdl, !NILP (flag)); - - return flag; -} - -DEFUN ("backtrace", Fbacktrace, Sbacktrace, 0, 0, "", - doc: /* Print a trace of Lisp function calls currently active. -Output stream used is value of `standard-output'. */) - (void) +static union specbinding * +get_backtrace_starting_at (Lisp_Object base) { union specbinding *pdl =3D backtrace_top (); - Lisp_Object tem; - Lisp_Object old_print_level =3D Vprint_level; =20 - if (NILP (Vprint_level)) - XSETFASTINT (Vprint_level, 8); - - while (backtrace_p (pdl)) - { - write_string (backtrace_debug_on_exit (pdl) ? "* " : " "); - if (backtrace_nargs (pdl) =3D=3D UNEVALLED) - { - Fprin1 (Fcons (backtrace_function (pdl), *backtrace_args (pdl)), - Qnil); - write_string ("\n"); - } - else - { - tem =3D backtrace_function (pdl); - if (debugger_stack_frame_as_list) - write_string ("("); - Fprin1 (tem, Qnil); /* This can QUIT. */ - if (!debugger_stack_frame_as_list) - write_string ("("); - { - ptrdiff_t i; - for (i =3D 0; i < backtrace_nargs (pdl); i++) - { - if (i || debugger_stack_frame_as_list) - write_string(" "); - Fprin1 (backtrace_args (pdl)[i], Qnil); - } - } - write_string (")\n"); - } - pdl =3D backtrace_next (pdl); + if (!NILP (base)) + { /* Skip up to `base'. */ + base =3D Findirect_function (base, Qt); + while (backtrace_p (pdl) + && !EQ (base, Findirect_function (backtrace_function (pdl),= Qt))) + pdl =3D backtrace_next (pdl); } =20 - Vprint_level =3D old_print_level; - return Qnil; + return pdl; } =20 static union specbinding * get_backtrace_frame (Lisp_Object nframes, Lisp_Object base) { - union specbinding *pdl =3D backtrace_top (); register EMACS_INT i; =20 CHECK_NATNUM (nframes); - - if (!NILP (base)) - { /* Skip up to `base'. */ - base =3D Findirect_function (base, Qt); - while (backtrace_p (pdl) - && !EQ (base, Findirect_function (backtrace_function (pdl), Qt))) - pdl =3D backtrace_next (pdl); - } + union specbinding *pdl =3D get_backtrace_starting_at (base); =20 /* Find the frame requested. */ for (i =3D XFASTINT (nframes); i > 0 && backtrace_p (pdl); i--) @@ -3490,33 +3432,71 @@ get_backtrace_frame (Lisp_Object nframes, Lisp_Ob= ject base) return pdl; } =20 -DEFUN ("backtrace-frame", Fbacktrace_frame, Sbacktrace_frame, 1, 2, NULL= , - doc: /* Return the function and arguments NFRAMES up from current= execution point. -If that frame has not evaluated the arguments yet (or is a special form)= , -the value is (nil FUNCTION ARG-FORMS...). -If that frame has evaluated its arguments and called its function alread= y, -the value is (t FUNCTION ARG-VALUES...). -A &rest arg is represented as the tail of the list ARG-VALUES. -FUNCTION is whatever was supplied as car of evaluated list, -or a lambda expression for macro calls. -If NFRAMES is more than the number of frames, the value is nil. -If BASE is non-nil, it should be a function and NFRAMES counts from its -nearest activation frame. */) - (Lisp_Object nframes, Lisp_Object base) +static Lisp_Object +backtrace_frame_apply (Lisp_Object function, union specbinding *pdl) { - union specbinding *pdl =3D get_backtrace_frame (nframes, base); - if (!backtrace_p (pdl)) return Qnil; + + Lisp_Object flags =3D Qnil; + if (backtrace_debug_on_exit (pdl)) + flags =3D Fcons (QCdebug_on_exit, Fcons (Qt, Qnil)); + if (backtrace_nargs (pdl) =3D=3D UNEVALLED) - return Fcons (Qnil, - Fcons (backtrace_function (pdl), *backtrace_args (pdl))); + return call4 (function, Qnil, backtrace_function (pdl), *backtrace_a= rgs (pdl), flags); else { Lisp_Object tem =3D Flist (backtrace_nargs (pdl), backtrace_args (= pdl)); + return call4 (function, Qt, backtrace_function (pdl), tem, flags);= + } +} =20 - return Fcons (Qt, Fcons (backtrace_function (pdl), tem)); +DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0, + doc: /* Set the debug-on-exit flag of eval frame LEVEL levels dow= n to FLAG. +The debugger is entered when that frame exits, if the flag is non-nil. = */) + (Lisp_Object level, Lisp_Object flag) +{ + CHECK_NUMBER (level); + union specbinding *pdl =3D get_backtrace_frame(level, Qnil); + + if (backtrace_p (pdl)) + set_backtrace_debug_on_exit (pdl, !NILP (flag)); + + return flag; +} + +DEFUN ("mapbacktrace", Fmapbacktrace, Smapbacktrace, 1, 2, 0, + doc: /* Call FUNCTION for each frame in backtrace. +If BASE is non-nil, it should be a function and iteration will start +from its nearest activation frame. +FUNCTION is called with 4 arguments: EVALD, FUNC, ARGS, and FLAGS. If +a frame has not evaluated its arguments yet or is a special form, +EVALD is nil and ARGS is a list of forms. If a frame has evaluated +its arguments and called its function already, EVALD is t and ARGS is +a list of values. +FLAGS is a plist of properties of the current frame: currently, the +only supported property is :debug-on-exit. `mapbacktrace' always +returns nil. */) + (Lisp_Object function, Lisp_Object base) +{ + union specbinding *pdl =3D get_backtrace_starting_at (base); + + while (backtrace_p (pdl)) + { + backtrace_frame_apply (function, pdl); + pdl =3D backtrace_next (pdl); } + + return Qnil; +} + +DEFUN ("backtrace-frame--internal", Fbacktrace_frame_internal, + Sbacktrace_frame_internal, 3, 3, NULL, + doc: /* Call FUNCTION on stack frame NFRAMES away from BASE. +Return the result of FUNCTION, or nil if no matching frame could be foun= d. */) + (Lisp_Object function, Lisp_Object nframes, Lisp_Object base) +{ + return backtrace_frame_apply (function, get_backtrace_frame (nframes, = base)); } =20 /* For backtrace-eval, we want to temporarily unwind the last few elemen= ts of @@ -3973,8 +3953,9 @@ alist of active lexical bindings. */); defsubr (&Srun_hook_wrapped); defsubr (&Sfetch_bytecode); defsubr (&Sbacktrace_debug); - defsubr (&Sbacktrace); - defsubr (&Sbacktrace_frame); + DEFSYM (QCdebug_on_exit, ":debug-on-exit"); + defsubr (&Smapbacktrace); + defsubr (&Sbacktrace_frame_internal); defsubr (&Sbacktrace_eval); defsubr (&Sbacktrace__locals); defsubr (&Sspecial_variable_p); diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index ce21290..82a70ca 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 "beta= 22_8alpha3"))) "Invalid version syntax: `beta22_8alpha3' (must start with= a number)")))) =20 +(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 --=20 2.7.4 --------------9F630B155F6BD35DD7A092CE-- --LhxtXlweULhsKHV1xm110FiSxFuSdQtNU-- --4Lk7XNSvF5p7xhDuXIxD1OBmSqgCCtbMb Content-Type: application/pgp-signature; name="signature.asc" Content-Description: OpenPGP digital signature Content-Disposition: attachment; filename="signature.asc" -----BEGIN PGP SIGNATURE----- Version: GnuPG v2 iQIcBAEBCAAGBQJYR8flAAoJEPqg+cTm90wjV4AP/35G+atYF5ZCrvo61kNeRheZ cVqjPiNzfgx1VKoLHiB5J84I4UxOogTnPct7GjN/0DILpEj7VmK+TRqyS57XqWBF KhM/CR9cziuz7AIAyNo6F/oaM0lied1+qu2nQJlIBfdKTYX4Yno3hV+BbeNQZeH7 Pu2Uu9mdO3dCv1kalXQvM1Zytu2eGHLyQNolhS5O9IWNBTArj+EOWYZ9smiuyOsD XP75kK4uxkDxl62l+1CX2fWaf7ZG7XtS2vp+l4eAtWYnlciQwI8no/9XwITOPgW2 i+H3OcJXG+4ynCjP8YnSA51i2/Ab1/xz4dt8ac6ba0f6X7wgUfLux36rzaUXdrcW OBIQUfTGA7EUgjfV01yp+ZvqOrEfTr57s0yBl+kUnX4v+Y5UK4GL5RM0GznI3ASF 4VIltFGGnFe3wzvQ0xdLtpq/zpvK0VuIGMo/aOpqxmF8AxGCATuFxYDzQqaI/+0N eyXPRzE8HVQWw30e2SDxx3n/IN5OtJJhdvwI8A4pNwCUPg2bv9CDFfo7pFl9NmIi whe3w+93kNTtW04w2W0cvD4JmJkxfxnh+JaNvLkgf31hH/cQSjyiV8Q/nQhUPfT2 qytskLuf2wm9xTwyYuW3vEIfmIw/xNif9Gv37iqhhxKvfYEwim8rrmXjty5n9hZR hk7lnxlr6X6qbyV8ik2W =UNjW -----END PGP SIGNATURE----- --4Lk7XNSvF5p7xhDuXIxD1OBmSqgCCtbMb--