bug#29091: VPATH builds are broken

[Ludovic Courtès]

Hi Eric,

Eric Bavier <address@hidden> skribis:

> Starting at commit 2890ad332fcdfd4bc92b127d783975437c8b718b, vpath builds no 
> longer work.  I.e. one must configure and build in $(top_srcdir).  I believe 
> this also means that `make distcheck` will fail.  I get the following 
> backtrace from compile-all.scm:

Good catch!  AFAICS this is fixed by the attached patch.  I’ll commit it
soon if that’s fine with you.

Thanks for your report!

Ludo’.

>From 17b45feb84594e57b487d525810d3d70693ad792 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <address@hidden>
Date: Sun, 5 Nov 2017 12:49:57 +0100
Subject: [PATCH] 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    | 53 +++++++++++++++++++++-----------------------------
 2 files changed, 40 insertions(+), 41 deletions(-)

diff --git a/guix/build/compile.scm b/guix/build/compile.scm
index ea0c36fa3..8b5a2faf8 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 3573241a7..a011e366f 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
+      ;; 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)
-- 
2.14.2