derivations: Pass the derivation of guile-for-build to `imported-files' & co.

* guix/derivations.scm (%guile-for-build): Initialize to #f.
  (imported-files, imported-modules, compiled-modules): Add `guile'
  keyword parameter.  Pass it down to `build-expression->derivation'.
  (build-expression->derivation)[guile-drv]: New variable.  Pass it as
  the #:guile parameter for `imported-modules' and `compiled-modules'.

* tests/derivations.scm: Set %GUILE-FOR-BUILD to the derivation of
  %BOOTSTRAP-GUILE.
This commit is contained in:
Ludovic Courtès 2012-10-25 18:03:48 +02:00
parent 4033bde841
commit b272c47433
2 changed files with 29 additions and 12 deletions

View File

@ -451,7 +451,7 @@ known in advance, such as a file download."
(define %guile-for-build (define %guile-for-build
;; The derivation of the Guile to be used within the build environment, ;; The derivation of the Guile to be used within the build environment,
;; when using `build-expression->derivation'. ;; when using `build-expression->derivation'.
(make-parameter (false-if-exception (nixpkgs-derivation* "guile")))) (make-parameter #f))
(define (parent-directories file-name) (define (parent-directories file-name)
"Return the list of parent dirs of FILE-NAME, in the order in which an "Return the list of parent dirs of FILE-NAME, in the order in which an
@ -470,7 +470,9 @@ known in advance, such as a file download."
(string-tokenize (dirname file-name) not-slash)))))) (string-tokenize (dirname file-name) not-slash))))))
(define* (imported-files store files (define* (imported-files store files
#:key (name "file-import") (system (%current-system))) #:key (name "file-import")
(system (%current-system))
(guile (%guile-for-build)))
"Return a derivation that imports FILES into STORE. FILES must be a list "Return a derivation that imports FILES into STORE. FILES must be a list
of (FINAL-PATH . FILE-NAME) pairs; each FILE-NAME is read from the file of (FINAL-PATH . FILE-NAME) pairs; each FILE-NAME is read from the file
system, imported, and appears under FINAL-PATH in the resulting store path." system, imported, and appears under FINAL-PATH in the resulting store path."
@ -497,11 +499,13 @@ system, imported, and appears under FINAL-PATH in the resulting store path."
`((symlink ,store-path ,final-path))))) `((symlink ,store-path ,final-path)))))
files)))) files))))
(build-expression->derivation store name (%current-system) (build-expression->derivation store name (%current-system)
builder files))) builder files
#:guile-for-build guile)))
(define* (imported-modules store modules (define* (imported-modules store modules
#:key (name "module-import") #:key (name "module-import")
(system (%current-system))) (system (%current-system))
(guile (%guile-for-build)))
"Return a derivation that contains the source files of MODULES, a list of "Return a derivation that contains the source files of MODULES, a list of
module names such as `(ice-9 q)'. All of MODULES must be in the current module names such as `(ice-9 q)'. All of MODULES must be in the current
search path." search path."
@ -513,16 +517,19 @@ search path."
".scm"))) ".scm")))
(cons f (search-path %load-path f)))) (cons f (search-path %load-path f))))
modules))) modules)))
(imported-files store files #:name name #:system system))) (imported-files store files #:name name #:system system
#:guile guile)))
(define* (compiled-modules store modules (define* (compiled-modules store modules
#:key (name "module-import-compiled") #:key (name "module-import-compiled")
(system (%current-system))) (system (%current-system))
(guile (%guile-for-build)))
"Return a derivation that builds a tree containing the `.go' files "Return a derivation that builds a tree containing the `.go' files
corresponding to MODULES. All the MODULES are built in a context where corresponding to MODULES. All the MODULES are built in a context where
they can refer to each other." they can refer to each other."
(let* ((module-drv (imported-modules store modules (let* ((module-drv (imported-modules store modules
#:system system)) #:system system
#:guile guile))
(module-dir (derivation-path->output-path module-drv)) (module-dir (derivation-path->output-path module-drv))
(files (map (lambda (m) (files (map (lambda (m)
(let ((f (string-join (map symbol->string m) (let ((f (string-join (map symbol->string m)
@ -554,7 +561,8 @@ they can refer to each other."
files))) files)))
(build-expression->derivation store name system builder (build-expression->derivation store name system builder
`(("modules" ,module-drv))))) `(("modules" ,module-drv))
#:guile-for-build guile)))
(define* (build-expression->derivation store name system exp inputs (define* (build-expression->derivation store name system exp inputs
#:key (outputs '("out")) #:key (outputs '("out"))
@ -575,9 +583,11 @@ failed.
EXP is built using GUILE-FOR-BUILD (a derivation). When GUILE-FOR-BUILD is EXP is built using GUILE-FOR-BUILD (a derivation). When GUILE-FOR-BUILD is
omitted or is #f, the value of the `%guile-for-build' fluid is used instead." omitted or is #f, the value of the `%guile-for-build' fluid is used instead."
(define guile-drv
(or guile-for-build (%guile-for-build)))
(define guile (define guile
(string-append (derivation-path->output-path (or guile-for-build (string-append (derivation-path->output-path guile-drv)
(%guile-for-build)))
"/bin/guile")) "/bin/guile"))
(define module-form? (define module-form?
@ -631,11 +641,11 @@ omitted or is #f, the value of the `%guile-for-build' fluid is used instead."
(_ `(,exp)))))) (_ `(,exp))))))
(map second inputs))) (map second inputs)))
(mod-drv (and (pair? modules) (mod-drv (and (pair? modules)
(imported-modules store modules))) (imported-modules store modules #:guile guile-drv)))
(mod-dir (and mod-drv (mod-dir (and mod-drv
(derivation-path->output-path mod-drv))) (derivation-path->output-path mod-drv)))
(go-drv (and (pair? modules) (go-drv (and (pair? modules)
(compiled-modules store modules))) (compiled-modules store modules #:guile guile-drv)))
(go-dir (and go-drv (go-dir (and go-drv
(derivation-path->output-path go-drv)))) (derivation-path->output-path go-drv))))
(derivation store name system guile (derivation store name system guile

View File

@ -21,6 +21,8 @@
#:use-module (guix derivations) #:use-module (guix derivations)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module ((guix packages) #:select (package-derivation))
#:use-module ((distro packages base) #:select (%bootstrap-guile))
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-11) #:use-module (srfi srfi-11)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
@ -36,6 +38,11 @@
(define %store (define %store
(false-if-exception (open-connection))) (false-if-exception (open-connection)))
(when %store
;; By default, use %BOOTSTRAP-GUILE for the current system.
(let ((drv (package-derivation %store %bootstrap-guile)))
(%guile-for-build drv)))
(define (directory-contents dir) (define (directory-contents dir)
"Return an alist representing the contents of DIR." "Return an alist representing the contents of DIR."
(define prefix-len (string-length dir)) (define prefix-len (string-length dir))