futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

compile: Fix VPATH builds.

Browse Source 
Fixes <https://bugs.gnu.org/29091>.
Reported by Eric Bavier <bavier@cray.com>.

* guix/build/compile.scm (relative-file): New procedure.
(load-files): Use it before calling 'file-name->module-name'.
(compile-files): Likewise before calling 'scm->go'.
* guix/build/pull.scm (build-guix): Remove 'with-directory-excursion'
and file name hack from ce33c3af76.
Pass OUT to 'all-scheme-files'.
This commit is contained in:
Ludovic Courtès 2017-11-05 12:49:57 +01:00
parent 0ad5f80982
commit c9405c461b
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 40 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
guix/build/compile.scm
View File

@ -77,6 +77,12 @@
"Strip the \".scm\" suffix from FILE, and append \".go\"." "Strip the \".scm\" suffix from FILE, and append \".go\"."
(string-append (string-drop-right file 4) ".go")) (string-append (string-drop-right file 4) ".go"))
(define (relative-file directory file)
"Return FILE relative to DIRECTORY, if possible."
(if (string-prefix? (string-append directory "/") file)
(string-drop file (+ 1 (string-length directory)))
file))
(define* (load-files directory files (define* (load-files directory files
#:key #:key
(report-load (const #f)) (report-load (const #f))
@ -93,13 +99,14 @@
(report-load #f total completed)) (report-load #f total completed))
*unspecified*) *unspecified*)
((file files ...) ((file files ...)
(report-load file total completed) (let ((file (relative-file directory file)))
(format debug-port "~%loading '~a'...~%" file) (report-load file total completed)
(format debug-port "~%loading '~a'...~%" file)
(parameterize ((current-warning-port debug-port)) (parameterize ((current-warning-port debug-port))
(resolve-interface (file-name->module-name file))) (resolve-interface (file-name->module-name file)))
(loop files (+ 1 completed)))))) (loop files (+ 1 completed)))))))
(define-syntax-rule (with-augmented-search-path path item body ...) (define-syntax-rule (with-augmented-search-path path item body ...)
"Within the dynamic extent of BODY, augment PATH by adding ITEM to the "Within the dynamic extent of BODY, augment PATH by adding ITEM to the
@ -135,11 +142,12 @@ files are for HOST, a GNU triplet such as \"x86_64-linux-gnu\"."
(with-fluids ((*current-warning-prefix* "")) (with-fluids ((*current-warning-prefix* ""))
(with-target host (with-target host
(lambda () (lambda ()
(compile-file file (let ((relative (relative-file source-directory file)))
#:output-file (string-append build-directory "/" (compile-file file
(scm->go file)) #:output-file (string-append build-directory "/"
#:opts (append warning-options (scm->go relative))
(optimization-options file)))))) #:opts (append warning-options
(optimization-options relative)))))))
(with-mutex progress-lock (with-mutex progress-lock
(set! completed (+ 1 completed)))) (set! completed (+ 1 completed))))

53
guix/build/pull.scm
View File

@ -121,41 +121,32 @@ containing the source code. Write any debugging output to DEBUG-PORT."
;; Compile the .scm files. Hide warnings. ;; Compile the .scm files. Hide warnings.
(parameterize ((current-warning-port (%make-void-port "w"))) (parameterize ((current-warning-port (%make-void-port "w")))
(with-directory-excursion out ;; Filter out files depending on Guile-SSH when Guile-SSH is missing.
;; Filter out files depending on Guile-SSH when Guile-SSH is missing. (let ((files (filter has-all-its-dependencies?
(let ((files (filter has-all-its-dependencies? (all-scheme-files out))))
(all-scheme-files ".")))) (compile-files out out files
(compile-files out out
;; XXX: 'compile-files' except ready-to-use relative #:workers (parallel-job-count)
;; file names.
(map (lambda (file)
(if (string-prefix? "./" file)
(string-drop file 2)
file))
files)
#:workers (parallel-job-count) ;; Disable warnings.
#:warning-options '()
;; Disable warnings. #:report-load
#:warning-options '() (lambda (file total completed)
(display #\cr log-port)
(format log-port
"loading...\t~5,1f% of ~d files" ;FIXME: i18n
(* 100. (/ completed total)) total)
(force-output log-port)
(format debug-port "~%loading '~a'...~%" file))
#:report-load #:report-compilation
(lambda (file total completed) (lambda (file total completed)
(display #\cr log-port) (display #\cr log-port)
(format log-port (format log-port "compiling...\t~5,1f% of ~d files" ;FIXME: i18n
"loading...\t~5,1f% of ~d files" ;FIXME: i18n (* 100. (/ completed total)) total)
(* 100. (/ completed total)) total) (force-output log-port)
(force-output log-port) (format debug-port "~%compiling '~a'...~%" file))))))
(format debug-port "~%loading '~a'...~%" file))
#:report-compilation
(lambda (file total completed)
(display #\cr log-port)
(format log-port "compiling...\t~5,1f% of ~d files" ;FIXME: i18n
(* 100. (/ completed total)) total)
(force-output log-port)
(format debug-port "~%compiling '~a'...~%" file)))))))
(newline) (newline)
#t) #t)