From 33831cbd8aab2c3c83020e922c4c0dcd8ed070d0 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Fri, 16 Sep 2011 15:46:13 -0600
Subject: [PATCH] add test to run test suite in multiple places

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.
---
 collects/tests/racket/parallel.rktl      |  4 ++--
 collects/tests/racket/place-parallel.rkt | 29 ++++++++++++++++++++++++
 2 files changed, 31 insertions(+), 2 deletions(-)
 create mode 100644 collects/tests/racket/place-parallel.rkt

diff --git a/collects/tests/racket/parallel.rktl b/collects/tests/racket/parallel.rktl
index 535b3b9cc9..d9110105ca 100644
--- a/collects/tests/racket/parallel.rktl
+++ b/collects/tests/racket/parallel.rktl
@@ -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))))
diff --git a/collects/tests/racket/place-parallel.rkt b/collects/tests/racket/place-parallel.rkt
new file mode 100644
index 0000000000..142dce44fe
--- /dev/null
+++ b/collects/tests/racket/place-parallel.rkt
@@ -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))
+