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

Reorganize as function calls, to make it easier to customize.

Browse Source
This commit is contained in:
Eli Barzilay 2010-06-24 17:08:32 -04:00
parent a33f460b25
commit b46cb492bb
1 changed files with 33 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
collects/tests/run-automated-tests.rkt
View File

@ -24,24 +24,21 @@
;; `compile-omit-paths' in your test's info file. ;; `compile-omit-paths' in your test's info file.
;; Tests to run: ;; Tests to run:
;; Each should be a list with a mode symbol (`load' or `require'), ;; - Each should be a `test' call, with the path to the test file to
;; the path to the test file (relative to this script) and module ;; require (relative to this script).
;; specifications for things to require into the initial namespace (define (all-tests)
;; for the test before the test is loaded. ('no-handler is a (test "racket/quiet.rktl" #:load? #t #:handler? #f
;; special flag that means that errors raised by the test suite are #:additional-modules '(racket/init))
;; ignored, and should only be used by the racket tests.) ;; (test "planet/lang.rkt")
(define tests (test "typed-scheme/nightly-run.rkt" #:timeout 25)
'([no-handler load "racket/quiet.rktl" (lib "racket/init")] (test "match/plt-match-tests.rkt")
;; [require "planet/lang.rkt"] ;; (test "stepper/automatic-tests.rkt" #:additional-modules (scheme/base))
[require "typed-scheme/nightly-run.rkt"] (test "lazy/main.rkt")
[require "match/plt-match-tests.rkt"] (test "scribble/main.rkt")
;; [require "stepper/automatic-tests.rkt" (lib "scheme/base")] (test "net/main.rkt")
[require "lazy/main.rkt"] (test "file/main.rkt")
[require "scribble/main.rkt"] (test "profile/main.rkt")
[require "net/main.rkt"] )
[require "file/main.rkt"]
[require "profile/main.rkt"]
))
(require racket/runtime-path) (require racket/runtime-path)
@ -49,14 +46,15 @@
(define exit-code 0) (define exit-code 0)
(for ([t tests]) (define (test path
(define no-handler? (and (eq? 'no-handler (car t)) (set! t (cdr t)))) #:load? [load? #f] #:handler? [handler? #t]
(define name (cadr t)) #:timeout [timeout 10] ; in minutes
#:additional-modules [additional-modules '()])
(define stderr (current-error-port)) (define stderr (current-error-port))
(define (echo fmt . args) (define (echo fmt . args)
(flush-output (current-output-port)) (flush-output (current-output-port))
(flush-output (current-error-port)) (flush-output (current-error-port))
(fprintf stderr ">>> ~a: ~a\n" name (apply format fmt args))) (fprintf stderr ">>> ~a: ~a\n" path (apply format fmt args)))
(newline stderr) (newline stderr)
(echo "running...") (echo "running...")
(let/ec break (let/ec break
@ -68,20 +66,24 @@
(break))) (break)))
(define timeout-thread (define timeout-thread
(thread (let ([th (current-thread)]) (thread (let ([th (current-thread)])
(lambda () (sleep 1200) (echo "Timeout!") (break-thread th))))) (lambda ()
(sleep (* 60 timeout))
(echo "Timeout!")
(break-thread th)))))
(parameterize* ([exit-handler (parameterize* ([exit-handler
(lambda (n) (abort n "exit with error code ~a" n))] (lambda (n) (abort n "exit with error code ~a" n))]
[current-namespace (make-base-empty-namespace)]) [current-namespace (make-base-empty-namespace)])
(for-each namespace-require (cddr t)) (for-each namespace-require additional-modules)
(let ([thunk (lambda () (let ([thunk (lambda () ((if load? load namespace-require)
((case (car t) [(load) load] [(require) namespace-require]) (build-path here path)))])
(build-path here name)))]) (if handler?
(if no-handler?
(thunk)
(with-handlers ([void (lambda (exn) (with-handlers ([void (lambda (exn)
(abort 1 "error: ~a" (exn-message exn)))]) (abort 1 "error: ~a" (exn-message exn)))])
(thunk)))) (thunk))
(thunk)))
(kill-thread timeout-thread) (kill-thread timeout-thread)
(echo "no failures found.")))) (echo "no failures."))))
(all-tests)
(exit exit-code) (exit exit-code)