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 ce33c3af76.
Pass OUT to 'all-scheme-files'.
master
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

View File

@ -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))))

View File

@ -121,41 +121,32 @@ containing the source code. Write any debugging output to DEBUG-PORT."
;; Compile the .scm files. Hide warnings.
(parameterize ((current-warning-port (%make-void-port "w")))
(with-directory-excursion out
;; Filter out files depending on Guile-SSH when Guile-SSH is missing.
(let ((files (filter has-all-its-dependencies?
(all-scheme-files "."))))
(compile-files out out
;; Filter out files depending on Guile-SSH when Guile-SSH is missing.
(let ((files (filter has-all-its-dependencies?
(all-scheme-files out))))
(compile-files out out files
;; XXX: 'compile-files' except ready-to-use relative
;; file names.
(map (lambda (file)
(if (string-prefix? "./" file)
(string-drop file 2)
file))
files)
#:workers (parallel-job-count)
#:workers (parallel-job-count)
;; Disable warnings.
#:warning-options '()
;; Disable warnings.
#:warning-options '()
#:report-load
(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
(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-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)))))))
#: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)
#t)