[nongnu] elpa/buttercup e8140aa 133/340: Implement configurable stack traces

[ELPA Syncer]

branch: elpa/buttercup
commit e8140aa8f824ae6dadf78c664bf13c28a5e45dbf
Author: Ryan C. Thompson <rct@thompsonclan.org>
Commit: Jorgen Schäfer <Jorgen.Schaefer@gmail.com>

    Implement configurable stack traces
    
    Use the "--traceback" command-line option or set the
    "buttercup-stack-frame-style" variable to use this. Possible values
    are "crop", "full", and "pretty". This option still needs to be added
    to the documentation.
---
 buttercup.el | 58 ++++++++++++++++++++++++++++++++++++++++++++++++----------
 1 file changed, 48 insertions(+), 10 deletions(-)

diff --git a/buttercup.el b/buttercup.el
index dc7e48f..bf33e83 100644
--- a/buttercup.el
+++ b/buttercup.el
@@ -716,6 +716,14 @@ current directory."
         (args command-line-args-left))
     (while args
       (cond
+       ((member (car args) '("--traceback"))
+        (when (not (cdr args))
+          (error "Option requires argument: %s" (car args)))
+        ;; Make sure it's a valid style by trying to format a dummy
+        ;; frame with it
+        (buttercup--format-stack-frame '(t myfun 1 2) (intern (cadr args)))
+        (setq buttercup-stack-frame-style (intern (cadr args)))
+        (setq args (cddr args)))
        ((member (car args) '("-p" "--pattern"))
         (when (not (cdr args))
           (error "Option requires argument: %s" (car args)))
@@ -945,11 +953,8 @@ Calls either `buttercup-reporter-batch' or
            (when stack
              (buttercup--print "\nTraceback (most recent call last):\n")
              (dolist (frame stack)
-               (let ((line (format "  %S" (cdr frame))))
-                 (when (> (length line) 79)
-                   (setq line (concat (substring line 0 76)
-                                      "...")))
-                 (buttercup--print "%s\n" line))))
+               (let ((frame-text (buttercup--format-stack-frame frame)))
+                 (buttercup--print "%s\n" frame-text))))
            (cond
             ((stringp description)
              (buttercup--print "FAILED: %s\n" description))
@@ -1017,11 +1022,8 @@ Calls either `buttercup-reporter-batch' or
          (when stack
            (buttercup--print "\nTraceback (most recent call last):\n")
            (dolist (frame stack)
-             (let ((line (format "  %S" (cdr frame))))
-               (when (> (length line) 79)
-                 (setq line (concat (substring line 0 76)
-                                    "...")))
-               (buttercup--print "%s\n" line))))
+             (let ((frame-text (buttercup--format-stack-frame frame)))
+               (buttercup--print "%s\n" frame-text))))
          (cond
           ((stringp description)
            (buttercup--print (concat (buttercup-colorize "FAILED" 'red ) ": 
%s\n")
@@ -1154,6 +1156,42 @@ failed -- The second value is the description of the 
expectation
             frame (backtrace-frame n)))
     frame-list))
 
+(defvar buttercup-stack-frame-style (car '(crop full pretty))
+  "Style to use when printing stack traces of tests.
+
+`full' is roughly the same style as normal Emacs stack traces:
+print each stack frame in full with no line breaks. `crop' is
+like full, but truncates each line to 80 characters. `pretty'
+uses `pp' to generate a multi-line indented representation of
+each frame, and prefixes each stack frame with lambda or M to
+indicate whether it represents a normal evaluated function call
+or a macro/special form.")
+
+(defun buttercup--format-stack-frame (frame &optional style)
+  (pcase (or style buttercup-stack-frame-style 'crop)
+    (`full (format "  %S" (cdr frame)))
+    (`crop
+     (let ((line (buttercup--format-stack-frame frame 'full)))
+       ;; Note: this could be done sith `s-truncate' from the s
+       ;; package
+       (when (> (length line) 79)
+         (setq line (concat (substring line 0 76)
+                            "...")))
+       line))
+    (`pretty
+     (thread-last (pp-to-string (cdr frame))
+       ;; Delete empty trailing line
+       (replace-regexp-in-string "\n[[:space:]]*\\'"
+                                 "")
+       ;; Indent 2 spaces
+       (replace-regexp-in-string "^"
+                                 "  ")
+       ;; Prefix first line with lambda for function call and M for
+       ;; macro/special form
+       (replace-regexp-in-string "\\` "
+                                 (if (car frame) "λ" "M"))))
+    (_ (error "Unknown stack trace style: %S" style))))
+
 (defmacro buttercup-with-converted-ert-signals (&rest body)
   "Convert ERT signals to buttercup signals in BODY.