02/11: compile: Fix VPATH builds.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit c9405c461b1b37740bc0bb33c7043313978c0014
Author: Ludovic Courtès <address@hidden>
Date:   Sun Nov 5 12:49:57 2017 +0100

    compile: Fix VPATH builds.
    
    Fixes <https://bugs.gnu.org/29091>.
    Reported by Eric Bavier <address@hidden>.
    
    * 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'.
---
 guix/build/compile.scm | 28 ++++++++++++++---------
 guix/build/pull.scm    | 61 +++++++++++++++++++++-----------------------------
 2 files changed, 44 insertions(+), 45 deletions(-)

diff --git a/guix/build/compile.scm b/guix/build/compile.scm
index ea0c36f..8b5a2fa 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))))
 
diff --git a/guix/build/pull.scm b/guix/build/pull.scm
index 3573241..a011e36 100644
--- a/guix/build/pull.scm
+++ b/guix/build/pull.scm
@@ -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
-
-                         ;; 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)
-
-                         ;; 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-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)))))))
+      ;; 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
+
+                       #:workers (parallel-job-count)
+
+                       ;; 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-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)