diff options
author | Ludovic Courtès <ludo@gnu.org> | 2017-11-05 12:49:57 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2017-11-07 00:12:10 +0100 |
commit | c9405c461b1b37740bc0bb33c7043313978c0014 (patch) | |
tree | 273724dfab6ce89748c7ddb459f1d36b709f2c1e /guix/build/compile.scm | |
parent | 0ad5f8098292a3ed759b249acd48dc7107086c12 (diff) |
compile: Fix VPATH builds.
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 ce33c3af76b0e5c68cc42dddf2b9c4b017386fd8.
Pass OUT to 'all-scheme-files'.
Diffstat (limited to 'guix/build/compile.scm')
-rw-r--r-- | guix/build/compile.scm | 28 |
1 files changed, 18 insertions, 10 deletions
diff --git a/guix/build/compile.scm b/guix/build/compile.scm index ea0c36fa33..8b5a2faf84 100644 --- a/guix/build/compile.scm +++ b/guix/build/compile.scm @@ -77,6 +77,12 @@ "Strip the \".scm\" suffix from FILE, and append \".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 #:key (report-load (const #f)) @@ -93,13 +99,14 @@ (report-load #f total completed)) *unspecified*) ((file files ...) - (report-load file total completed) - (format debug-port "~%loading '~a'...~%" file) + (let ((file (relative-file directory file))) + (report-load file total completed) + (format debug-port "~%loading '~a'...~%" file) - (parameterize ((current-warning-port debug-port)) - (resolve-interface (file-name->module-name file))) + (parameterize ((current-warning-port debug-port)) + (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 ...) "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-target host (lambda () - (compile-file file - #:output-file (string-append build-directory "/" - (scm->go file)) - #:opts (append warning-options - (optimization-options file)))))) + (let ((relative (relative-file source-directory file))) + (compile-file file + #:output-file (string-append build-directory "/" + (scm->go relative)) + #:opts (append warning-options + (optimization-options relative))))))) (with-mutex progress-lock (set! completed (+ 1 completed)))) |