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

Make parallel-build send the whole filename to the worker.

Browse Source 
Closes PR 15000.
This commit is contained in:
Eric Dobson 2015-04-26 22:38:13 -07:00 committed by Matthew Flatt
parent 06634b74d5
commit 4e3a7c420a
2 changed files with 12 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
pkgs/racket-test/tests/setup/parallel-build.rkt
View File

@ -10,4 +10,5 @@
(define temporary-directory (make-temporary-file "parallel-build~a" 'directory)) (define temporary-directory (make-temporary-file "parallel-build~a" 'directory))
(check-false (parallel-compile-files (list temporary-directory))) (check-false (parallel-compile-files (list temporary-directory)))
(check-false (parallel-compile-files (list (build-path temporary-directory "new-directory" ".."))))
(delete-directory/files temporary-directory) (delete-directory/files temporary-directory)

23
racket/collects/setup/parallel-build.rkt
View File

@ -136,10 +136,9 @@
(define (retry) (get-job workerid)) (define (retry) (get-job workerid))
(define (build-job cc file last) (define (build-job cc file last)
(values (values
(list cc file last) (list cc file last)
(list (->bytes (cc-name cc)) (list (->bytes (cc-name cc))
(dir->bytes (cc-path cc)) (->bytes (build-path (cc-path cc) file))
(->bytes file)
options))) options)))
(match cc (match cc
[(list) [(list)
@ -251,8 +250,8 @@
(define-values (dir file b) (split-path hd)) (define-values (dir file b) (split-path hd))
(set! filelist tail) (set! filelist tail)
(handler workerid 'start hd "" "" "") (handler workerid 'start hd "" "" "")
(values hd (list (->bytes hd) (dir->bytes dir) (->bytes file) null))] (values hd (list (->bytes hd) (->bytes hd) null))]))
[(list) null]))
(define/public (has-jobs?) (not (null? filelist))) (define/public (has-jobs?) (not (null? filelist)))
(define/public (jobs-cnt) (length filelist)) (define/public (jobs-cnt) (length filelist))
(define/public (get-results) results) (define/public (get-results) results)
@ -274,10 +273,10 @@
(define cmc (make-caching-managed-compile-zo)) (define cmc (make-caching-managed-compile-zo))
(match-message-loop (match-message-loop
[(list name _dir _file options) [(list name _full-file options)
(DEBUG_COMM (eprintf "COMPILING ~a ~a ~a ~a\n" worker-id name _file _dir)) (DEBUG_COMM (eprintf "COMPILING ~a ~a ~a\n" worker-id name _full-file))
(define dir (bytes->path _dir)) (define full-file (bytes->path _full-file))
(define file (bytes->path _file)) (define-values (dir file _) (split-path full-file))
(define out-str-port (open-output-string)) (define out-str-port (open-output-string))
(define err-str-port (open-output-string)) (define err-str-port (open-output-string))
(define cip (current-input-port)) (define cip (current-input-port))
@ -291,7 +290,7 @@
(define (lock-client cmd fn) (define (lock-client cmd fn)
(match cmd (match cmd
['lock ['lock
(DEBUG_COMM (eprintf "REQUESTING LOCK ~a ~a ~a ~a\n" worker-id name _file _dir)) (DEBUG_COMM (eprintf "REQUESTING LOCK ~a ~a ~a\n" worker-id name _full-file))
(match (send/recv (list (list 'LOCK (path->bytes fn)) "" "")) (match (send/recv (list (list 'LOCK (path->bytes fn)) "" ""))
[(list 'locked) #t] [(list 'locked) #t]
[(list 'compiled) #f] [(list 'compiled) #f]
@ -299,7 +298,7 @@
[x (send/error (format "DIDNT MATCH B ~v\n" x))] [x (send/error (format "DIDNT MATCH B ~v\n" x))]
[else (send/error (format "DIDNT MATCH B\n"))])] [else (send/error (format "DIDNT MATCH B\n"))])]
['unlock ['unlock
(DEBUG_COMM (eprintf "UNLOCKING ~a ~a ~a ~a\n" worker-id name _file _dir)) (DEBUG_COMM (eprintf "UNLOCKING ~a ~a ~a\n" worker-id name _full-file))
(send/msg (list (list 'UNLOCK (path->bytes fn)) "" ""))] (send/msg (list (list 'UNLOCK (path->bytes fn)) "" ""))]
[x (send/error (format "DIDNT MATCH C ~v\n" x))] [x (send/error (format "DIDNT MATCH C ~v\n" x))]
[else (send/error (format "DIDNT MATCH C\n"))])) [else (send/error (format "DIDNT MATCH C\n"))]))