[nongnu] elpa/buttercup 315a891 326/340: Fix stack frame collection in buttercup--backtrace

[ELPA Syncer]

branch: elpa/buttercup
commit 315a891f8ab68800d57c3a50fed6a58364652a53
Author: Ola Nilsson <ola.nilsson@gmail.com>
Commit: Ola Nilsson <ola.nilsson@gmail.com>

    Fix stack frame collection in buttercup--backtrace
    
    Changes to the inner workings of buttercup has made the condition for
    when to stop collecting frames out-of-date.  Looking for
    buttercup--funcall is no longer enough; buttercup--expr-and-value and
    buttercup--apply-matcher must alse be used.  The number of frames to
    discard depends on which of these functions is found.
    
    The frame inspection loop is rewritten using cl-do*, which allows for
    early exit with cl-return.
---
 buttercup.el | 33 +++++++++++++++++++++------------
 1 file changed, 21 insertions(+), 12 deletions(-)

diff --git a/buttercup.el b/buttercup.el
index c7ec197..40efbd3 100644
--- a/buttercup.el
+++ b/buttercup.el
@@ -1923,23 +1923,32 @@ ARGS according to `debugger'."
 
 (defun buttercup--backtrace ()
   "Create a backtrace, a list of frames returned from `backtrace-frame'."
-  (let* ((n 0)
-         (frame (backtrace-frame n))
-         (frame-list nil)
-         (in-program-stack nil))
-    (while frame
+  ;; Read the backtrace frames from 0 (the closest) upward.
+  (cl-do* ((n 0 (1+ n))
+           (frame (backtrace-frame n) (backtrace-frame n))
+           (frame-list nil)
+           (in-program-stack nil)
+           (discard-frames nil))
+      ((not frame) frame-list)
+      ;; discard frames until (and including) `buttercup--debugger', they
+      ;; only contain buttercup code
       (when in-program-stack
         (push frame frame-list))
       (when (eq (elt frame 1)
                 'buttercup--debugger)
         (setq in-program-stack t))
-      (when (eq (elt frame 1)
-                'buttercup--funcall)
-        (setq in-program-stack nil
-              frame-list (nthcdr 6 frame-list)))
-      (setq n (1+ n)
-            frame (backtrace-frame n)))
-    frame-list))
+      ;; keep frames until one of the known functions are found, after
+      ;; this is just the buttercup framework and not interesting for
+      ;; users incorrect for testing buttercup. Some frames before the
+      ;; function also have to be discarded
+      (when (and in-program-stack
+                 (setq discard-frames
+                       (pcase (elt frame 1)
+                         (`buttercup--expr-and-value 2)   ; matcher modified 
with :not
+                         (`buttercup--apply-matcher 4) ; unmodified matcher
+                         (`buttercup--funcall 6))))
+        (setq frame-list (nthcdr discard-frames frame-list))
+        (cl-return frame-list))))
 
 (defun buttercup--format-stack-frame (frame &optional style)
   "Format stack FRAME according to STYLE.