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

Use (chibi term ansi) library in (chibi test) instead of inlined ansi procedures.

Browse source
This commit is contained in:
Alex Shinn 2014-07-22 23:36:43 +09:00
parent 1925b068ef
commit 76501b602f
2 changed files with 110 additions and 134 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

47
lib/chibi/test.scm
View file

@ -1,4 +1,4 @@
;; Copyright (c) 2010-2013 Alex Shinn. All rights reserved.
;; Copyright (c) 2010-2014 Alex Shinn. All rights reserved.
;; BSD-style license: http://synthcode.com/license.txt
;;> Simple testing framework adapted from the Chicken \scheme{test}
@ -285,6 +285,9 @@
(display ")" out)))
(write x out))))))
(define (display-to-string x)
(if (string? x) x (call-with-output-string (lambda (out) (display x out)))))
;; if we need to truncate, try first dropping let's to get at the
;; heart of the expression
(define (truncate-source x width . o)
@ -353,22 +356,6 @@
(test-first-indentation))))))
(* 4 (min level (test-max-indentation)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ansi tools
(define (display-to-string x)
(if (string? x) x (call-with-output-string (lambda (out) (display x out)))))
(define (ansi-color code)
(lambda (x)
(string-append "\x1B;[" (number->string code) "m"
(display-to-string x) "\x1B;[0m")))
(define red (ansi-color 31))
(define green (ansi-color 32))
(define yellow (ansi-color 33))
(define bold (ansi-color 1))
(define underline (ansi-color 4))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (test-expand-info info)
@ -427,13 +414,11 @@
((current-test-handler) 'SKIP info))
(define (test-status-color status)
(if (test-ansi?)
(case status
((ERROR) (lambda (x) (underline (red x))))
((FAIL) red)
((SKIP) yellow)
(else (lambda (x) x)))
(lambda (x) x)))
(else (lambda (x) x))))
(define (test-status-message status)
((test-status-color status) status))
@ -520,7 +505,7 @@
(make-string (if (pair? indent) (car indent) 0) #\space)
"-- " str " "))
(len (string-length header)))
(display (if (test-ansi?) (bold header) header))
(display (bold header))
(display (make-string (max 0 (- (current-column-width) len)) #\-))
(newline)))
@ -607,7 +592,7 @@
((positive? count)
(display indent)
(display
((if (and (test-ansi?) (= pass count)) green (lambda (x) x))
((if (= pass count) green (lambda (x) x))
(string-append
(number->string pass) " out of " (number->string count)
(percent pass count))))
@ -623,14 +608,14 @@
(cond ((positive? fail)
(display indent)
(display
((if (test-ansi?) red (lambda (x) x))
(red
(string-append
(number->string fail) (plural " failure" fail)
(percent fail count) ".\n")))))
(cond ((positive? err)
(display indent)
(display
((if (test-ansi?) (lambda (x) (underline (red x))) (lambda (x) x))
((lambda (x) (underline (red x)))
(string-append
(number->string err) (plural " error" err)
(percent err count) ".\n")))))
@ -639,7 +624,7 @@
(for-each
(lambda (failure)
(display indent)
(display ((if (test-ansi?) red (lambda (x) x))
(display (red
(string-append (display-to-string (cadr failure)) ": ")))
(display (test-get-name! (car (cddr failure))))
(newline)
@ -649,7 +634,7 @@
((positive? subgroups-count)
(display indent)
(display
((if (and (test-ansi?) (= subgroups-pass subgroups-count))
((if (= subgroups-pass subgroups-count)
green (lambda (x) x))
(string-append
(number->string subgroups-pass) " out of "
@ -809,13 +794,3 @@
=> string->number)
(else #f))
78)))
(define test-ansi?
(make-parameter
(cond
((get-environment-variable "TEST_USE_ANSI")
=> (lambda (s) (not (equal? s "0"))))
(else
(member (get-environment-variable "TERM")
'("xterm" "xterm-color" "xterm-256color" "rxvt" "kterm"
"linux" "screen" "screen-256color" "vt100"))))))

3
lib/chibi/test.sld
View file

@ -12,7 +12,8 @@
(import (scheme write)
(scheme complex)
(scheme process-context)
(scheme time))
(scheme time)
(chibi term ansi))
(cond-expand
(chibi
(import (except (scheme base) guard)