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

core tests: repair and improve summary after sandboxed tests

Browse Source
This commit is contained in:
Matthew Flatt 2019-01-20 10:08:50 -07:00
parent 55788b9ffa
commit cad79fe2b6
1 changed files with 31 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
pkgs/racket-test-core/tests/racket/testing.rktl
View File

@ -75,6 +75,10 @@ transcript.
(define number-of-error-tests 0) (define number-of-error-tests 0)
(define number-of-exn-tests 0) (define number-of-exn-tests 0)
(define accum-number-of-tests 0)
(define accum-number-of-error-tests 0)
(define accum-number-of-exn-tests 0)
(define (load-in-sandbox file #:testing [testing "testing.rktl"]) (define (load-in-sandbox file #:testing [testing "testing.rktl"])
(define-syntax-rule (S id) (dynamic-require 'racket/sandbox 'id)) (define-syntax-rule (S id) (dynamic-require 'racket/sandbox 'id))
(let ([e ((S call-with-trusted-sandbox-configuration) (let ([e ((S call-with-trusted-sandbox-configuration)
@ -89,14 +93,14 @@ transcript.
(e `(define real-error-port (quote ,real-error-port))) (e `(define real-error-port (quote ,real-error-port)))
(e `(define Section-prefix ,Section-prefix)) (e `(define Section-prefix ,Section-prefix))
(e `(load-relative (quote ,file))) (e `(load-relative (quote ,file)))
(let ([l (e '(list number-of-tests (let ([l (e '(list accum-number-of-tests
number-of-error-tests accum-number-of-error-tests
number-of-exn-tests accum-number-of-exn-tests
errs))]) accum-errs))])
(set! number-of-tests (+ number-of-tests (list-ref l 0))) (set! accum-number-of-tests (+ accum-number-of-tests (list-ref l 0)))
(set! number-of-error-tests (+ number-of-error-tests (list-ref l 1))) (set! accum-number-of-error-tests (+ accum-number-of-error-tests (list-ref l 1)))
(set! number-of-exn-tests (+ number-of-exn-tests (list-ref l 2))) (set! accum-number-of-exn-tests (+ accum-number-of-exn-tests (list-ref l 2)))
(set! errs (append (list-ref l 3) errs))))) (set! accum-errs (append (list-ref l 3) accum-errs)))))
(define test (define test
(let () (let ()
@ -325,13 +329,22 @@ transcript.
(define (report-errs [final? #f]) (define (report-errs [final? #f])
(when final? (when final?
(set! errs (append errs accum-errs)) (set! errs (append errs accum-errs))
(set! accum-errs null)) (set! number-of-tests (+ number-of-tests accum-number-of-tests))
(let* ([ok? (null? errs)]) (set! number-of-error-tests (+ number-of-error-tests accum-number-of-error-tests))
(set! number-of-exn-tests (+ number-of-error-tests accum-number-of-exn-tests))
(set! accum-errs null)
(set! accum-number-of-tests 0)
(set! accum-number-of-error-tests 0)
(set! accum-number-of-exn-tests 0))
(let* ([ok? (null? errs)])
(parameterize ([current-output-port (parameterize ([current-output-port
(cond [(not ok?) (or real-error-port (current-error-port))] (cond [(not ok?) (or real-error-port (current-error-port))]
[final? (or real-output-port (current-output-port))] [final? (or real-output-port (current-output-port))]
[else (current-output-port)])]) [else (current-output-port)])])
(printf "\n~aPerformed ~a expression tests (~a ~a, ~a ~a)\n" (newline)
(when final?
(printf "SUMMARY ----------------------------\n"))
(printf "~aPerformed ~a expression tests (~a ~a, ~a ~a)\n"
Section-prefix Section-prefix
(+ number-of-tests number-of-error-tests) (+ number-of-tests number-of-error-tests)
number-of-tests "value expressions" number-of-tests "value expressions"
@ -353,7 +366,13 @@ transcript.
(newline) (newline)
(flush-output) (flush-output)
(set! accum-errs (append errs accum-errs)) (set! accum-errs (append errs accum-errs))
(set! errs null)))) (set! accum-number-of-tests (+ number-of-tests accum-number-of-tests))
(set! accum-number-of-error-tests (+ number-of-error-tests accum-number-of-error-tests))
(set! accum-number-of-exn-tests (+ number-of-error-tests accum-number-of-exn-tests))
(set! errs null)
(set! number-of-tests 0)
(set! number-of-error-tests 0)
(set! number-of-exn-tests 0))))
(define type? exn:application:type?) (define type? exn:application:type?)
(define arity? exn:application:arity?) (define arity? exn:application:arity?)