nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

pull: Compile modules correctly regardless of the compilation order. 

* guix/scripts/pull.scm (unpack)[builder]: Work around
  <http://bugs.gnu.org/15602>.
This commit is contained in:
Ludovic Courtès 2013-10-13 22:22:42 +02:00
parent 973d9f1d1c
commit 178f77b2d2
1 changed files with 45 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
guix/scripts/pull.scm
View File

@ -45,15 +45,54 @@ files."
(use-modules (guix build utils) (use-modules (guix build utils)
(system base compile) (system base compile)
(ice-9 ftw) (ice-9 ftw)
(ice-9 match)) (ice-9 match)
(srfi srfi-1)
(srfi srfi-11)
(srfi srfi-26))
(setvbuf (current-output-port) _IOLBF) (setvbuf (current-output-port) _IOLBF)
(setvbuf (current-error-port) _IOLBF) (setvbuf (current-error-port) _IOLBF)
(let ((out (assoc-ref %outputs "out")) (let ((out (assoc-ref %outputs "out"))
(tar (assoc-ref %build-inputs "tar")) (tar (assoc-ref %build-inputs "tar"))
(gzip (assoc-ref %build-inputs "gzip")) (gzip (assoc-ref %build-inputs "gzip"))
(gcrypt (assoc-ref %build-inputs "gcrypt")) (gcrypt (assoc-ref %build-inputs "gcrypt"))
(tarball (assoc-ref %build-inputs "tarball"))) (tarball (assoc-ref %build-inputs "tarball")))
(define* (compile-file* file #:key output-file (opts '()))
;; Like 'compile-file', but remove any (guix …) and (gnu …) modules
;; created during the process as an ugly workaround for
;; <http://bugs.gnu.org/15602> (FIXME). This ensures correctness,
;; but is overly conservative and very slow.
(define (module-directory+file module)
;; Return the directory for MODULE, like the 'dir-hint' in
;; boot-9.scm.
(match (module-name module)
((beginning ... last)
(values (string-concatenate
(map (lambda (elt)
(string-append (symbol->string elt)
file-name-separator-string))
beginning))
(symbol->string last)))))
(define (clear-module-tree! root)
;; Delete all the modules under ROOT.
(hash-for-each (lambda (name module)
(module-remove! root name)
(let-values (((dir name)
(module-directory+file module)))
(set-autoloaded! dir name #f))
(clear-module-tree! module))
(module-submodules root))
(hash-clear! (module-submodules root)))
(compile-file file #:output-file output-file #:opts opts)
(for-each (compose clear-module-tree! resolve-module)
'((guix) (gnu))))
(setenv "PATH" (string-append tar "/bin:" gzip "/bin")) (setenv "PATH" (string-append tar "/bin:" gzip "/bin"))
(system* "tar" "xvf" tarball) (system* "tar" "xvf" tarball)
@ -91,15 +130,12 @@ files."
".go"))) ".go")))
(format (current-error-port) (format (current-error-port)
"compiling '~a'...~%" file) "compiling '~a'...~%" file)
(compile-file file (compile-file* file
#:output-file go #:output-file go
#:opts %auto-compilation-options)))) #:opts
%auto-compilation-options))))
;; XXX: Because of the autoload hack in (guix build (find-files out "\\.scm"))
;; download), we must build it first to avoid errors since
;; (gnutls) is unavailable.
(cons (string-append out "/guix/build/download.scm")
(find-files out "\\.scm")))
;; Remove the "fake" (guix config). ;; Remove the "fake" (guix config).
(delete-file (string-append out "/guix/config.scm")) (delete-file (string-append out "/guix/config.scm"))