rackunit: prevent test case from killing test-runner thread
closes PR 11586
This commit is contained in:
parent
528c05b228
commit
a100395626
|
@ -26,7 +26,8 @@
|
|||
;; Run a test-case immediately, printing information on failure
|
||||
(define (default-test-case-around thunk)
|
||||
(with-handlers ([(lambda (e) #t) default-test-case-handler])
|
||||
(thunk)))
|
||||
(parameterize ((current-custodian (make-custodian)))
|
||||
(thunk))))
|
||||
|
||||
;; default-test-case-handler : any -> any
|
||||
(define (default-test-case-handler e)
|
||||
|
|
|
@ -216,27 +216,28 @@
|
|||
|
||||
;; run-tests : test [(U 'quiet 'normal 'verbose)] -> integer
|
||||
(define (run-tests test [mode 'normal])
|
||||
(monad-value
|
||||
((compose
|
||||
(sequence*
|
||||
(parameterize ((current-custodian (make-custodian)))
|
||||
(monad-value
|
||||
((compose
|
||||
(sequence*
|
||||
(case mode
|
||||
[(normal verbose)
|
||||
(display-counter*)]
|
||||
[(quiet)
|
||||
(lambda (a) a)])
|
||||
(counter->vector))
|
||||
(match-lambda
|
||||
((vector s f e)
|
||||
(return-hash (+ f e)))))
|
||||
(case mode
|
||||
[(normal verbose)
|
||||
(display-counter*)]
|
||||
[(quiet)
|
||||
(lambda (a) a)])
|
||||
(counter->vector))
|
||||
(match-lambda
|
||||
((vector s f e)
|
||||
(return-hash (+ f e)))))
|
||||
(case mode
|
||||
((quiet)
|
||||
(fold-test-results
|
||||
(lambda (result seed)
|
||||
((update-counter! result) seed))
|
||||
((put-initial-counter)
|
||||
(make-empty-hash))
|
||||
test))
|
||||
((normal) (std-test/text-ui display-context test))
|
||||
((verbose) (std-test/text-ui
|
||||
(lambda (x) (display-context x #t))
|
||||
test))))))
|
||||
((quiet)
|
||||
(fold-test-results
|
||||
(lambda (result seed)
|
||||
((update-counter! result) seed))
|
||||
((put-initial-counter)
|
||||
(make-empty-hash))
|
||||
test))
|
||||
((normal) (std-test/text-ui display-context test))
|
||||
((verbose) (std-test/text-ui
|
||||
(lambda (x) (display-context x #t))
|
||||
test)))))))
|
||||
|
|
|
@ -220,5 +220,19 @@
|
|||
(check = foo 2)))
|
||||
'verbose)
|
||||
(check = foo 3)))))
|
||||
))
|
||||
|
||||
(test-case
|
||||
"cannot kill current thread in test case"
|
||||
(check-equal? (call-in-nested-thread
|
||||
(lambda ()
|
||||
(with-silent-output
|
||||
(lambda ()
|
||||
(run-tests
|
||||
(test-suite "tests"
|
||||
(test-case "kill-thread"
|
||||
(kill-thread (current-thread)))))))))
|
||||
;; If the kill-thread were successful, call-in-nested-thread
|
||||
;; would raise error. We expect kill-thread to raise error,
|
||||
;; caught by run-tests.
|
||||
1))
|
||||
))
|
||||
|
|
Loading…
Reference in New Issue
Block a user