mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 05:18:07 -05:00
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'.
This commit is contained in:
parent
0ad5f80982
commit
c9405c461b
2 changed files with 40 additions and 41 deletions
|
@ -77,6 +77,12 @@ (define (scm->go file)
|
|||
"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 @@ (define total
|
|||
(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 @@ (define (build file)
|
|||
(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))))
|
||||
|
||||
|
|
|
@ -121,41 +121,32 @@ (define* (build-guix out source
|
|||
|
||||
;; 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)
|
||||
|
|
Loading…
Reference in a new issue