~ruther/guix-local

c9405c461b1b37740bc0bb33c7043313978c0014 — Ludovic Courtès 8 years ago 0ad5f80
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'.
2 files changed, 44 insertions(+), 45 deletions(-)

M guix/build/compile.scm
M guix/build/pull.scm
M guix/build/compile.scm => guix/build/compile.scm +18 -10
@@ 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))))


M guix/build/pull.scm => guix/build/pull.scm +26 -35
@@ 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)