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

add test to run test suite in multiple places

Browse Source 
This is something we've done in the past, but it doesn't seem
to be in the tree anywhere.

Also, repair old "parallel.rktl" test.
This commit is contained in:
Matthew Flatt 2011-09-16 15:46:13 -06:00
parent 1bfd9987c4
commit 33831cbd8a
2 changed files with 31 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/tests/racket/parallel.rktl
View File

@ -36,7 +36,7 @@
[cust (list-ref custodians (sub1 n))]
[ql (namespace-variable-value 'quiet-load #f
(lambda () #f))])
(namespace-attach-module (current-namespace) 'scheme/init ns)
(namespace-attach-module (current-namespace) 'racket/init ns)
(parameterize ([current-custodian cust])
(thread
(lambda ()
@ -44,7 +44,7 @@
n
(lambda ()
(parameterize ([current-namespace ns])
(namespace-require '(lib "scheme/init"))
(namespace-require '(lib "racket/init"))
(eval `(define Section-prefix ,(format "~a:" n)))
(when ql
(eval `(define quiet-load (quote ,ql))))

29
collects/tests/racket/place-parallel.rkt Normal file
View File

@ -0,0 +1,29 @@
#lang racket
(provide main)
;; Runs 3 places perfoming the test suite simultaneously. Each
;; thread creates a directory sub<n> to run in, so that filesystem
;; tests don't collide.
(define (go n test)
(let ([dirname (path->complete-path (format "sub~s" n))])
(when (directory-exists? dirname)
(delete-directory/files dirname))
(make-directory dirname)
(current-directory dirname)
(namespace-require '(lib "racket/init"))
(load (build-path 'up test))
(when (directory-exists? dirname)
(delete-directory/files dirname))))
(define (main)
(define ps
(for/list ([i 3])
(let ([p (place ch (go (place-channel-get ch)
(place-channel-get ch)))])
(place-channel-put p i)
(place-channel-put p "quiet.rktl")
p)))
(map place-wait ps))