Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-09 14:07:34 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Aligning line wrap in nested test groups.

Browse source
This commit is contained in:
Alex Shinn 2013-04-01 23:31:19 +09:00
parent 39b67ea455
commit 98bad7bc63
1 changed files with 18 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

32
lib/chibi/test.scm
View file

@ -1,4 +1,4 @@
;; Copyright (c) 2010-2012 Alex Shinn. All rights reserved. ;; Copyright (c) 2010-2013 Alex Shinn. All rights reserved.
;; BSD-style license: http://synthcode.com/license.txt ;; BSD-style license: http://synthcode.com/license.txt
;;> Simple testing framework adapted from the Chicken @scheme{test} ;;> Simple testing framework adapted from the Chicken @scheme{test}
@ -525,19 +525,23 @@
(else 0))) (else 0)))
#\space)) #\space))
;; update group info ;; update group info
(cond ((current-test-group) (cond
=> (lambda (group) ((current-test-group)
(if (not (eq? 'SKIP status)) => (lambda (group)
(test-group-inc! group 'count)) (if (not (eq? 'SKIP status))
(test-group-inc! group status)))) (test-group-inc! group 'count))
(if (and (current-test-group) (test-group-inc! group status)
(zero? ;; maybe wrap long status lines
(modulo (let ((width (max (- (current-column-width)
(+ (string-length (test-group-name (current-test-group))) (or (test-group-indent-width group) 0))
(or (test-group-ref (current-test-group) 'count) 0) 4))
1) (column
(current-column-width)))) (+ (string-length (or (test-group-name group) ""))
(display (string-append "\n" (string-copy indent 4)))) (or (test-group-ref group 'count) 0)
1)))
(if (and (zero? (modulo column width))
(not (test-group-ref group 'verbose)))
(display (string-append "\n" (string-copy indent 4))))))))
;; update global failure count for exit status ;; update global failure count for exit status
(cond (cond
((or (eq? status 'FAIL) (eq? status 'ERROR)) ((or (eq? status 'FAIL) (eq? status 'ERROR))