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

cleanup

Browse Source
This commit is contained in:
Jay McCarthy 2010-11-16 16:29:49 -07:00
parent e3153e6d21
commit 88fb21fa26
1 changed files with 16 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
collects/meta/drdr/plt-build.rkt
View File

@ -211,7 +211,7 @@
(lambda () (lambda ()
(list* gracket-path (list* gracket-path
"-display" "-display"
(format ":~a" (+ XSERVER-OFFSET (current-worker))) (format ":~a" (cpu->child (current-worker)))
rst)) rst))
#f)] #f)]
[_ [_
@ -224,7 +224,7 @@
void void
(λ () (λ ()
(define l (pth-cmd)) (define l (pth-cmd))
(with-env (["DISPLAY" (format ":~a" (+ XSERVER-OFFSET (current-worker)))]) (with-env (["DISPLAY" (format ":~a" (cpu->child (current-worker)))])
(with-temporary-home-directory (with-temporary-home-directory
(with-temporary-directory (with-temporary-directory
(run/collect/wait/log log-pth (run/collect/wait/log log-pth
@ -277,7 +277,10 @@
(recur-many (sub1 i) r f))))) (recur-many (sub1 i) r f)))))
(define XSERVER-OFFSET 20) (define XSERVER-OFFSET 20)
(define PARENT-X-SERVER 19) (define (cpu->parent cpu-i)
(+ XSERVER-OFFSET (* cpu-i 2) 0))
(define (cpu->child cpu-i)
(+ XSERVER-OFFSET (* cpu-i 2) 1))
(define (integrate-revision rev) (define (integrate-revision rev)
(define test-dir (define test-dir
@ -325,6 +328,7 @@
(with-running-program (with-running-program
(Xvfb-path) (list (format ":~a" i) "-ac" "-rfbauth" "/home/jay/.vnc/passwd") (Xvfb-path) (list (format ":~a" i) "-ac" "-rfbauth" "/home/jay/.vnc/passwd")
(lambda () (lambda ()
(sleep 1)
(with-running-program (with-running-program
(fluxbox-path) (list "-display" (format ":~a" i) "-rc" "/home/jay/.fluxbox/init") (fluxbox-path) (list "-display" (format ":~a" i) "-rc" "/home/jay/.fluxbox/init")
(if parent (if parent
@ -335,15 +339,15 @@
inner)) inner))
inner))))) inner)))))
(start-x-server
PARENT-X-SERVER #f
(λ ()
(recur-many (number-of-cpus) (recur-many (number-of-cpus)
(lambda (j inner) (lambda (cpu-i inner)
(define i (+ j XSERVER-OFFSET)) (define parent (cpu->parent cpu-i))
(start-x-server i PARENT-X-SERVER inner)) (define child (cpu->child cpu-i))
(start-x-server parent #f
(λ ()
(start-x-server child parent inner))))
(lambda () (lambda ()
(test-revision rev))))))) (test-revision rev)))))
; Remove the test directory ; Remove the test directory
(safely-delete-directory test-dir)))) (safely-delete-directory test-dir))))