rackunit: prevent test case from killing test-runner thread

closes PR 11586
This commit is contained in:
Ryan Culpepper 2011-10-07 15:38:06 -06:00
parent 528c05b228
commit a100395626
3 changed files with 41 additions and 25 deletions

View File

@ -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)

View File

@ -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)))))))

View File

@ -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))
))