suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

try to sort outputs out

Browse Source 
svn: r16463
This commit is contained in:
Eli Barzilay 2009-10-30 06:42:51 +00:00
parent b7db9e4e67
commit f03518f7cc
2 changed files with 35 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
collects/tests/mzscheme/quiet.ss
View File

@ -7,15 +7,17 @@
(define timeout-thread #f)
(namespace-variable-value 'real-error-port #f
(namespace-variable-value 'real-output-port #f
(lambda ()
(let ([err (current-error-port)]
(let ([outp (current-output-port)]
[errp (current-error-port)]
[exit (exit-handler)]
[errh (uncaught-exception-handler)]
[esch (error-escape-handler)]
[cust (current-custodian)]
[orig-thread (current-thread)])
(namespace-set-variable-value! 'real-error-port err)
(namespace-set-variable-value! 'real-output-port outp)
(namespace-set-variable-value! 'real-error-port errp)
(namespace-set-variable-value! 'last-error #f)
;; we're loading this for the first time:
;; make real errors show by remembering the exn

56
collects/tests/mzscheme/testing.ss
View File

@ -51,19 +51,17 @@ transcript.
(defvar building-flat-tests? #f)
(defvar in-drscheme? #f)
;; used for quiet testing (quiet.ss) to really show something
;; used when quiet testing (through "quiet.ss") to really show something
(defvar real-output-port #f)
(defvar real-error-port #f)
(define (eprintf* fmt . args)
(let ([msg (apply format fmt args)]
[err (or real-error-port (current-error-port))])
(display msg err)
(flush-output err)))
(define Section-prefix
(namespace-variable-value 'Section-prefix #f (lambda () "")))
(define (Section . args)
(eprintf* "~aSection~s\n" Section-prefix args)
(let ([p (or real-output-port (current-output-port))])
(fprintf p "~aSection~s\n" Section-prefix args)
(flush-output p))
(set! cur-section args)
#t)
@ -86,7 +84,8 @@ transcript.
[(S sandbox-memory-limit) 100]) ; 100mb per box
((S make-evaluator) '(begin) #:requires (list 'scheme)))))])
(e `(load-relative "testing.ss"))
(e `(define real-error-port (quote ,real-error-port)))
(e `(define real-output-port (quote ,real-output-port)))
(e `(define real-error-port (quote ,real-error-port)))
(e `(define Section-prefix ,Section-prefix))
(e `(load-relative (quote ,file)))
(let ([l (e '(list number-of-tests
@ -304,25 +303,30 @@ transcript.
(define (report-errs . final?)
(let* ([final? (and (pair? final?) (car final?))]
[printf (if final? eprintf* printf)]
[ok? (null? errs)])
(printf "\n~aPerformed ~a expression tests (~a ~a, ~a ~a)\n"
Section-prefix
(+ number-of-tests number-of-error-tests)
number-of-tests "value expressions"
number-of-error-tests "exn expressions")
(printf "~aand ~a exception field tests.\n\n"
Section-prefix
number-of-exn-tests)
(if ok?
(printf "~aPassed all tests.\n" Section-prefix)
(begin (printf "~aErrors were:\n~a(Section (got expected (call)))\n"
Section-prefix Section-prefix)
(for-each (lambda (l) (printf "~a~s\n" Section-prefix l)) (reverse errs))
(when final? (exit 1))))
(when final? (exit (if ok? 0 1)))
(printf "(Other messages report successful tests of~a.)\n"
" error-handling behavior")))
(parameterize ([current-output-port
(cond [(not ok?) (or real-error-port (current-error-port))]
[final? (or real-output-port (current-output-port))]
[else (current-output-port)])])
(printf "\n~aPerformed ~a expression tests (~a ~a, ~a ~a)\n"
Section-prefix
(+ number-of-tests number-of-error-tests)
number-of-tests "value expressions"
number-of-error-tests "exn expressions")
(printf "~aand ~a exception field tests.\n\n"
Section-prefix
number-of-exn-tests)
(if ok?
(printf "~aPassed all tests.\n" Section-prefix)
(begin (printf "~aErrors were:\n~a(Section (got expected (call)))\n"
Section-prefix Section-prefix)
(for-each (lambda (l) (printf "~a~s\n" Section-prefix l))
(reverse errs))
(when final? (exit 1))))
(when final? (exit (if ok? 0 1)))
(printf "(Other messages report successful tests of~a.)\n"
" error-handling behavior")
(flush-output))))
(define type? exn:application:type?)
(define arity? exn:application:arity?)