1. Moritz Heidkamp
  2. missbehave

Commits

Moritz Heidkamp  committed 3ee996c

display detailed exception information on error and properly indent multi-line matcher output.

  • Participants
  • Parent commits 477c1c6
  • Branches default

Comments (0)

Files changed (2)

File behave.scm

View file
       (report-example-colors status result failure-index)
       (report-example-plain status result failure-index)))
 
+(define (indent n str)
+  (let ((indention (make-string n #\space)))
+    (display indention)
+    (display (irregex-replace/all "\n" str (string-append "\n" indention)))))
+
 (define (report-example-colors status result  #!optional (failure-index #f))
   (let ((example (example-result-example result)))
     (case status
       ((success)
-       (fmt #t (cat (space-to 2) (fmt-green (cat "It " (example-description example)))))
+       (indent 2 (fmt #f (fmt-green (cat "It " (example-description example)))))
        (newline))
       ((pending)
-       (fmt #t (cat (space-to 2) (fmt-yellow (cat "[P] It " (example-description example)))))
+       (indent 2 (fmt #f (fmt-yellow (cat "[P] It " (example-description example)))))
        (newline))
       (else
-       (fmt #t (cat (space-to 2) (fmt-red (cat "[F][" (number->string failure-index) "] It " (example-description example) ))))
+       (indent 2 (fmt #f (fmt-red (cat "[F][" (number->string failure-index) "] It " (example-description example) ))))
        (newline)
-       (fmt #t (cat (space-to 4) (fmt-red (example-result-messages result))))
+       (indent 4 (fmt #f (fmt-red (example-result-messages result))))
        (newline)))))
 
 (define (report-example-plain status result #!optional (failure-index #f))
   (let ((example (example-result-example result)))
     (case status
       ((success)
-       (fmt #t (cat (space-to 2) (cat "It " (example-description example))))
+       (indent 2 (fmt #f (cat "It " (example-description example))))
        (newline))
       ((pending)
-       (fmt #t (cat (space-to 2) (cat "[P] It " (example-description example))))
+       (indent 2 (fmt #f (cat "[P] It " (example-description example))))
        (newline))
       (else
-       (fmt #t (cat (space-to 2)  (cat "[F][" (number->string failure-index) "] It " (example-description example))))
+       (indent 2 (fmt #f (cat "[F][" (number->string failure-index) "] It " (example-description example))))
        (newline)
-       (fmt #t (cat (space-to 4)  (example-result-messages result)))
+       (indent 4 (fmt #f (example-result-messages result)))
        (newline)))))
 
 
 
     (fmt #t (fmt-bold (fmt-red (cat (failure-index failure) ") in " (relativize-path file)))))
     (newline)
-    (fmt #t (cat (space-to 2) (fmt-red (cat "[F][" (number->string (failure-index failure)) "] It " (example-description example)))))
+    (indent 2 (fmt #f (fmt-red (cat "[F][" (number->string (failure-index failure)) "] It " (example-description example)))))
     (newline)
-    (fmt #t (cat (space-to 4) (fmt-red (example-result-messages result))))
+    (indent 4 (fmt #f (fmt-red (example-result-messages result))))
     (newline)
     (newline)))
 

File missbehave.scm

View file
 
   )
 
-(import chicken scheme extras data-structures)
+(import chicken scheme extras data-structures ports)
 (require-library defstruct srfi-1 regex advice srfi-69)
 
 (import srfi-1)
       (example-spec-file-set! example (current-spec-file))
       (context-examples-set! context (cons example (context-examples context))))))
 
+(define (format-condition-properties exn without)
+  (let* ((cps (condition->list exn))
+         (eps (remove (lambda (x) (memq (car x) without))
+                      (or (alist-ref 'exn cps) '())))
+         (cps (alist-update! 'exn eps cps)))
+    (with-output-to-string
+        (lambda ()
+          (for-each 
+           (lambda (cp)
+             (printf "~A:~%" (car cp))
+             (for-each (lambda (p)
+                         (printf "  ~A: ~S~%" (car p) (cadr p)))
+                       (cdr cp)))
+           cps)))))
+
 (define (run-example example)
   (let((behaviour (example-behaviour example))
        (result    (make-example-result status: 'succeeded example: example messages: '() spec-file: (example-spec-file example))))
            (handle-exceptions exn
                (begin
 ;                (signal exn)
-                 (fail-current-example-with! (sprintf "Error: ~S" ((condition-property-accessor 'exn 'message) exn))))
+                 (fail-current-example-with! (sprintf "Error: ~S~%~A"
+                                                      ((condition-property-accessor 'exn 'message) exn)
+                                                      (format-condition-properties exn '(message call-chain)))))
              (call-with-exit-handler behaviour (make-exit-handler exit result)))))))
        result)))