mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -05:00
derivations: 'derivation' and related procedures return a single value.
* guix/derivations.scm (derivation->output-path, derivation->output-paths): New procedures. (derivation-path->output-path): Use 'derivation->output-path'. (derivation-path->output-paths): Use 'derivation->output-paths'. (derivation): Accept 'derivation?' objects as inputs. Return a single value. (build-derivations): New procedure. (compiled-modules): Use 'derivation->output-paths'. (build-expression->derivation)[source-path]: Add case for when the input matches 'derivation?'. [prologue]: Accept 'derivation?' objects in INPUTS. [mod-dir, go-dir]: Use 'derivation->output-path'. * guix/download.scm (url-fetch): Adjust to the single-value return. * guix/packages.scm (package-output): Use 'derivation->output-path'. * guix/scripts/build.scm (guix-build): When the argument is 'derivation-path?', pass it through 'read-derivation'. Use 'derivation-file-name' to print out the .drv file names, and to register them. Use 'derivation->output-path' instead of 'derivation-path->output-path'. * guix/scripts/package.scm (roll-back): Adjust to the single-value return. (guix-package): Use 'derivation->output-path'. * guix/ui.scm (show-what-to-build): Adjust to deal with 'derivation?' objects instead of .drv file names. * gnu/system/grub.scm (grub-configuration-file): Use 'derivation->output-path' instead of 'derivation-path->output-path'. * gnu/system/vm.scm (qemu-image, system-qemu-image): Likewise. * tests/builders.scm, tests/derivations.scm, tests/packages.scm, tests/store.scm, tests/union.scm: Adjust to the new calling convention. * doc/guix.texi (Defining Packages, The Store, Derivations): Adjust accordingly.
This commit is contained in:
Ludovic Courtès
parent
81b66f8567
commit
59688fc4b5
18 changed files with 295 additions and 290 deletions
|
|
@ -987,8 +987,8 @@ The build actions it prescribes may then be realized by using the
|
|||
@code{build-derivations} procedure (@pxref{The Store}).
|
||||
|
||||
@deffn {Scheme Procedure} package-derivation @var{store} @var{package} [@var{system}]
|
||||
Return the derivation path and corresponding @code{<derivation>} object
|
||||
of @var{package} for @var{system} (@pxref{Derivations}).
|
||||
Return the @code{<derivation>} object of @var{package} for @var{system}
|
||||
(@pxref{Derivations}).
|
||||
|
||||
@var{package} must be a valid @code{<package>} object, and @var{system}
|
||||
must be a string denoting the target system type---e.g.,
|
||||
|
|
@ -1004,8 +1004,8 @@ package for some other system:
|
|||
|
||||
@deffn {Scheme Procedure} package-cross-derivation @var{store} @
|
||||
@var{package} @var{target} [@var{system}]
|
||||
Return the derivation path and corresponding @code{<derivation>} object
|
||||
of @var{package} cross-built from @var{system} to @var{target}.
|
||||
Return the @code{<derivation>} object of @var{package} cross-built from
|
||||
@var{system} to @var{target}.
|
||||
|
||||
@var{target} must be a valid GNU triplet denoting the target hardware
|
||||
and operating system, such as @code{"mips64el-linux-gnu"}
|
||||
|
|
@ -1068,8 +1068,9 @@ resulting store path.
|
|||
@end deffn
|
||||
|
||||
@deffn {Scheme Procedure} build-derivations @var{server} @var{derivations}
|
||||
Build @var{derivations} (a list of derivation paths), and return when
|
||||
the worker is done building them. Return @code{#t} on success.
|
||||
Build @var{derivations} (a list of @code{<derivation>} objects or
|
||||
derivation paths), and return when the worker is done building them.
|
||||
Return @code{#t} on success.
|
||||
@end deffn
|
||||
|
||||
@c FIXME
|
||||
|
|
@ -1119,8 +1120,8 @@ otherwise manipulate derivations. The lowest-level primitive to create
|
|||
a derivation is the @code{derivation} procedure:
|
||||
|
||||
@deffn {Scheme Procedure} derivation @var{store} @var{name} @var{builder} @var{args} [#:outputs '("out")] [#:hash #f] [#:hash-algo #f] [#:hash-mode #f] [#:inputs '()] [#:env-vars '()] [#:system (%current-system)] [#:references-graphs #f]
|
||||
Build a derivation with the given arguments. Return the resulting store
|
||||
path and @code{<derivation>} object.
|
||||
Build a derivation with the given arguments, and return the resulting
|
||||
@code{<derivation>} object.
|
||||
|
||||
When @var{hash}, @var{hash-algo}, and @var{hash-mode} are given, a
|
||||
@dfn{fixed-output derivation} is created---i.e., one whose result is
|
||||
|
|
@ -1142,16 +1143,13 @@ to a Bash executable in the store:
|
|||
(guix store)
|
||||
(guix derivations))
|
||||
|
||||
(call-with-values
|
||||
(lambda ()
|
||||
(let ((builder ; add the Bash script to the store
|
||||
(add-text-to-store store "my-builder.sh"
|
||||
"echo hello world > $out\n" '())))
|
||||
(derivation store "foo"
|
||||
bash `("-e" ,builder)
|
||||
#:env-vars '(("HOME" . "/homeless")))))
|
||||
list)
|
||||
@result{} ("/nix/store/@dots{}-foo.drv" #<<derivation> @dots{}>)
|
||||
(let ((builder ; add the Bash script to the store
|
||||
(add-text-to-store store "my-builder.sh"
|
||||
"echo hello world > $out\n" '())))
|
||||
(derivation store "foo"
|
||||
bash `("-e" ,builder)
|
||||
#:env-vars '(("HOME" . "/homeless"))))
|
||||
@result{} #<derivation /nix/store/@dots{}-foo.drv => /nix/store/@dots{}-foo>
|
||||
@end lisp
|
||||
|
||||
As can be guessed, this primitive is cumbersome to use directly. An
|
||||
|
|
@ -1196,8 +1194,7 @@ containing one file:
|
|||
(build-expression->derivation store "goo" (%current-system)
|
||||
builder '()))
|
||||
|
||||
@result{} "/nix/store/@dots{}-goo.drv"
|
||||
@result{} #<<derivation> @dots{}>
|
||||
@result{} #<derivation /nix/store/@dots{}-goo.drv => @dots{}>
|
||||
@end lisp
|
||||
|
||||
@cindex strata of code
|
||||
|
|
|
|||
|
|
@ -56,7 +56,7 @@ (define prologue
|
|||
(any (match-lambda
|
||||
(($ <menu-entry> _ linux)
|
||||
(let* ((drv (package-derivation store linux system))
|
||||
(out (derivation-path->output-path drv)))
|
||||
(out (derivation->output-path drv)))
|
||||
(string-append out "/bzImage"))))
|
||||
entries)))
|
||||
|
||||
|
|
@ -71,9 +71,9 @@ (define entry->text
|
|||
initrd ~a/initrd
|
||||
}~%"
|
||||
label
|
||||
(derivation-path->output-path linux-drv)
|
||||
(derivation->output-path linux-drv)
|
||||
(string-join arguments)
|
||||
(derivation-path->output-path initrd-drv))))))
|
||||
(derivation->output-path initrd-drv))))))
|
||||
|
||||
(add-text-to-store store "grub.cfg"
|
||||
(string-append prologue
|
||||
|
|
|
|||
|
|
@ -206,10 +206,10 @@ (define* (qemu-image store #:key
|
|||
(define input->name+derivation
|
||||
(match-lambda
|
||||
((name (? package? package))
|
||||
`(,name . ,(derivation-path->output-path
|
||||
`(,name . ,(derivation->output-path
|
||||
(package-derivation store package system))))
|
||||
((name (? package? package) sub-drv)
|
||||
`(,name . ,(derivation-path->output-path
|
||||
`(,name . ,(derivation->output-path
|
||||
(package-derivation store package system)
|
||||
sub-drv)))
|
||||
((input (and (? string?) (? store-path?) file))
|
||||
|
|
@ -361,14 +361,14 @@ (define %pam-services
|
|||
|
||||
(parameterize ((%guile-for-build (package-derivation store guile-final)))
|
||||
(let* ((bash-drv (package-derivation store bash))
|
||||
(bash-file (string-append (derivation-path->output-path bash-drv)
|
||||
(bash-file (string-append (derivation->output-path bash-drv)
|
||||
"/bin/bash"))
|
||||
(accounts (list (vector "root" "" 0 0 "System administrator"
|
||||
"/" bash-file)))
|
||||
(passwd (passwd-file store accounts))
|
||||
(shadow (passwd-file store accounts #:shadow? #t))
|
||||
(pam.d-drv (pam-services->directory store %pam-services))
|
||||
(pam.d (derivation-path->output-path pam.d-drv))
|
||||
(pam.d (derivation->output-path pam.d-drv))
|
||||
(populate
|
||||
(add-text-to-store store "populate-qemu-image"
|
||||
(object->string
|
||||
|
|
@ -381,11 +381,11 @@ (define %pam-services
|
|||
(symlink ,pam.d "etc/pam.d")
|
||||
(mkdir-p "var/run")))
|
||||
(list passwd)))
|
||||
(out (derivation-path->output-path
|
||||
(out (derivation->output-path
|
||||
(package-derivation store mingetty)))
|
||||
(getty (string-append out "/sbin/mingetty"))
|
||||
(iu-drv (package-derivation store inetutils))
|
||||
(syslogd (string-append (derivation-path->output-path iu-drv)
|
||||
(syslogd (string-append (derivation->output-path iu-drv)
|
||||
"/libexec/syslogd"))
|
||||
(boot (add-text-to-store store "boot"
|
||||
(object->string
|
||||
|
|
|
|||
|
|
@ -72,9 +72,9 @@ (define* (cmake-build store name source inputs
|
|||
(define builder
|
||||
`(begin
|
||||
(use-modules ,@modules)
|
||||
(cmake-build #:source ,(if (and source (derivation-path? source))
|
||||
(derivation-path->output-path source)
|
||||
source)
|
||||
(cmake-build #:source ,(if (derivation? source)
|
||||
(derivation->output-path source)
|
||||
source)
|
||||
#:system ,system
|
||||
#:outputs %outputs
|
||||
#:inputs %build-inputs
|
||||
|
|
|
|||
|
|
@ -291,8 +291,8 @@ (define implicit-search-paths
|
|||
(define builder
|
||||
`(begin
|
||||
(use-modules ,@modules)
|
||||
(gnu-build #:source ,(if (and source (derivation-path? source))
|
||||
(derivation-path->output-path source)
|
||||
(gnu-build #:source ,(if (derivation? source)
|
||||
(derivation->output-path source)
|
||||
source)
|
||||
#:system ,system
|
||||
#:outputs %outputs
|
||||
|
|
@ -319,8 +319,8 @@ (define guile-for-build
|
|||
(match guile
|
||||
((? package?)
|
||||
(package-derivation store guile system))
|
||||
((and (? string?) (? derivation-path?))
|
||||
guile)
|
||||
;; ((and (? string?) (? derivation-path?))
|
||||
;; guile)
|
||||
(#f ; the default
|
||||
(let* ((distro (resolve-interface '(gnu packages base)))
|
||||
(guile (module-ref distro 'guile-final)))
|
||||
|
|
@ -438,6 +438,8 @@ (define builder
|
|||
(let ()
|
||||
(define %build-host-inputs
|
||||
',(map (match-lambda
|
||||
((name (? derivation? drv) sub ...)
|
||||
`(,name . ,(apply derivation->output-path drv sub)))
|
||||
((name (? derivation-path? drv-path) sub ...)
|
||||
`(,name . ,(apply derivation-path->output-path
|
||||
drv-path sub)))
|
||||
|
|
@ -447,6 +449,8 @@ (define %build-host-inputs
|
|||
|
||||
(define %build-target-inputs
|
||||
',(map (match-lambda
|
||||
((name (? derivation? drv) sub ...)
|
||||
`(,name . ,(apply derivation->output-path drv sub)))
|
||||
((name (? derivation-path? drv-path) sub ...)
|
||||
`(,name . ,(apply derivation-path->output-path
|
||||
drv-path sub)))
|
||||
|
|
@ -454,8 +458,8 @@ (define %build-target-inputs
|
|||
`(,name . ,path)))
|
||||
(append (or implicit-target-inputs '()) inputs)))
|
||||
|
||||
(gnu-build #:source ,(if (and source (derivation-path? source))
|
||||
(derivation-path->output-path source)
|
||||
(gnu-build #:source ,(if (derivation? source)
|
||||
(derivation->output-path source)
|
||||
source)
|
||||
#:system ,system
|
||||
#:target ,target
|
||||
|
|
@ -488,8 +492,8 @@ (define guile-for-build
|
|||
(match guile
|
||||
((? package?)
|
||||
(package-derivation store guile system))
|
||||
((and (? string?) (? derivation-path?))
|
||||
guile)
|
||||
;; ((and (? string?) (? derivation-path?))
|
||||
;; guile)
|
||||
(#f ; the default
|
||||
(let* ((distro (resolve-interface '(gnu packages base)))
|
||||
(guile (module-ref distro 'guile-final)))
|
||||
|
|
|
|||
|
|
@ -62,8 +62,8 @@ (define builder
|
|||
`(begin
|
||||
(use-modules ,@modules)
|
||||
(perl-build #:name ,name
|
||||
#:source ,(if (and source (derivation-path? source))
|
||||
(derivation-path->output-path source)
|
||||
#:source ,(if (derivation? source)
|
||||
(derivation->output-path source)
|
||||
source)
|
||||
#:search-paths ',(map search-path-specification->sexp
|
||||
(append perl-search-paths
|
||||
|
|
|
|||
|
|
@ -120,8 +120,8 @@ (define builder
|
|||
`(begin
|
||||
(use-modules ,@modules)
|
||||
(python-build #:name ,name
|
||||
#:source ,(if (and source (derivation-path? source))
|
||||
(derivation-path->output-path source)
|
||||
#:source ,(if (derivation? source)
|
||||
(derivation->output-path source)
|
||||
source)
|
||||
#:configure-flags ,configure-flags
|
||||
#:system ,system
|
||||
|
|
|
|||
|
|
@ -58,6 +58,8 @@ (define-module (guix derivations)
|
|||
|
||||
read-derivation
|
||||
write-derivation
|
||||
derivation->output-path
|
||||
derivation->output-paths
|
||||
derivation-path->output-path
|
||||
derivation-path->output-paths
|
||||
derivation
|
||||
|
|
@ -66,7 +68,8 @@ (define-module (guix derivations)
|
|||
imported-modules
|
||||
compiled-modules
|
||||
build-expression->derivation
|
||||
imported-files))
|
||||
imported-files)
|
||||
#:replace (build-derivations))
|
||||
|
||||
;;;
|
||||
;;; Nix derivations, as implemented in Nix's `derivations.cc'.
|
||||
|
|
@ -420,25 +423,30 @@ (define (write-env-var env-var port)
|
|||
port)
|
||||
(display ")" port))))
|
||||
|
||||
(define* (derivation->output-path drv #:optional (output "out"))
|
||||
"Return the store path of its output OUTPUT."
|
||||
(let ((outputs (derivation-outputs drv)))
|
||||
(and=> (assoc-ref outputs output) derivation-output-path)))
|
||||
|
||||
(define (derivation->output-paths drv)
|
||||
"Return the list of name/path pairs of the outputs of DRV."
|
||||
(map (match-lambda
|
||||
((name . output)
|
||||
(cons name (derivation-output-path output))))
|
||||
(derivation-outputs drv)))
|
||||
|
||||
(define derivation-path->output-path
|
||||
;; This procedure is called frequently, so memoize it.
|
||||
(memoize
|
||||
(lambda* (path #:optional (output "out"))
|
||||
"Read the derivation from PATH (`/nix/store/xxx.drv'), and return the store
|
||||
path of its output OUTPUT."
|
||||
(let* ((drv (call-with-input-file path read-derivation))
|
||||
(outputs (derivation-outputs drv)))
|
||||
(and=> (assoc-ref outputs output) derivation-output-path)))))
|
||||
(derivation->output-path (call-with-input-file path read-derivation)))))
|
||||
|
||||
(define (derivation-path->output-paths path)
|
||||
"Read the derivation from PATH (`/nix/store/xxx.drv'), and return the
|
||||
list of name/path pairs of its outputs."
|
||||
(let* ((drv (call-with-input-file path read-derivation))
|
||||
(outputs (derivation-outputs drv)))
|
||||
(map (match-lambda
|
||||
((name . output)
|
||||
(cons name (derivation-output-path output))))
|
||||
outputs)))
|
||||
(derivation->output-paths (call-with-input-file path read-derivation)))
|
||||
|
||||
|
||||
;;;
|
||||
|
|
@ -522,10 +530,10 @@ (define* (derivation store name builder args
|
|||
(inputs '()) (outputs '("out"))
|
||||
hash hash-algo hash-mode
|
||||
references-graphs)
|
||||
"Build a derivation with the given arguments. Return the resulting
|
||||
store path and <derivation> object. When HASH, HASH-ALGO, and HASH-MODE
|
||||
are given, a fixed-output derivation is created---i.e., one whose result is
|
||||
known in advance, such as a file download.
|
||||
"Build a derivation with the given arguments, and return the resulting
|
||||
<derivation> object. When HASH, HASH-ALGO, and HASH-MODE are given, a
|
||||
fixed-output derivation is created---i.e., one whose result is known in
|
||||
advance, such as a file download.
|
||||
|
||||
When REFERENCES-GRAPHS is true, it must be a list of file name/store path
|
||||
pairs. In that case, the reference graph of each store path is exported in
|
||||
|
|
@ -610,6 +618,12 @@ (define (set-file-name drv file)
|
|||
(make-derivation-output "" hash-algo hash)))
|
||||
outputs))
|
||||
(inputs (map (match-lambda
|
||||
(((? derivation? drv))
|
||||
(make-derivation-input (derivation-file-name drv)
|
||||
'("out")))
|
||||
(((? derivation? drv) sub-drvs ...)
|
||||
(make-derivation-input (derivation-file-name drv)
|
||||
sub-drvs))
|
||||
(((? direct-store-path? input))
|
||||
(make-derivation-input input '("out")))
|
||||
(((? direct-store-path? input) sub-drvs ...)
|
||||
|
|
@ -638,7 +652,21 @@ (define (set-file-name drv file)
|
|||
(cut write-derivation drv <>))
|
||||
(map derivation-input-path
|
||||
inputs))))
|
||||
(values file (set-file-name drv file)))))
|
||||
(set-file-name drv file))))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Store compatibility layer.
|
||||
;;;
|
||||
|
||||
(define (build-derivations store derivations)
|
||||
"Build DERIVATIONS, a list of <derivation> objects or .drv file names."
|
||||
(let ((build (@ (guix store) build-derivations)))
|
||||
(build store (map (match-lambda
|
||||
((? string? file) file)
|
||||
((and drv ($ <derivation>))
|
||||
(derivation-file-name drv)))
|
||||
derivations))))
|
||||
|
||||
|
||||
;;;
|
||||
|
|
@ -730,7 +758,7 @@ (define* (compiled-modules store modules
|
|||
#:system system
|
||||
#:guile guile
|
||||
#:module-path module-path))
|
||||
(module-dir (derivation-path->output-path module-drv))
|
||||
(module-dir (derivation->output-path module-drv))
|
||||
(files (map (lambda (m)
|
||||
(let ((f (string-join (map symbol->string m)
|
||||
"/")))
|
||||
|
|
@ -794,7 +822,7 @@ (define guile-drv
|
|||
(or guile-for-build (%guile-for-build)))
|
||||
|
||||
(define guile
|
||||
(string-append (derivation-path->output-path guile-drv)
|
||||
(string-append (derivation->output-path guile-drv)
|
||||
"/bin/guile"))
|
||||
|
||||
(define module-form?
|
||||
|
|
@ -806,6 +834,8 @@ (define source-path
|
|||
;; When passed an input that is a source, return its path; otherwise
|
||||
;; return #f.
|
||||
(match-lambda
|
||||
((_ (? derivation?) _ ...)
|
||||
#f)
|
||||
((_ path _ ...)
|
||||
(and (not (derivation-path? path))
|
||||
path))))
|
||||
|
|
@ -830,10 +860,13 @@ (define %build-inputs
|
|||
(() "out")
|
||||
((x) x))))
|
||||
(cons name
|
||||
(if (derivation-path? drv)
|
||||
(derivation-path->output-path drv
|
||||
sub)
|
||||
drv)))))
|
||||
(cond
|
||||
((derivation? drv)
|
||||
(derivation->output-path drv sub))
|
||||
((derivation-path? drv)
|
||||
(derivation-path->output-path drv
|
||||
sub))
|
||||
(else drv))))))
|
||||
inputs))
|
||||
|
||||
,@(if (null? modules)
|
||||
|
|
@ -878,13 +911,13 @@ (define %build-inputs
|
|||
#:guile guile-drv
|
||||
#:system system)))
|
||||
(mod-dir (and mod-drv
|
||||
(derivation-path->output-path mod-drv)))
|
||||
(derivation->output-path mod-drv)))
|
||||
(go-drv (and (pair? modules)
|
||||
(compiled-modules store modules
|
||||
#:guile guile-drv
|
||||
#:system system)))
|
||||
(go-dir (and go-drv
|
||||
(derivation-path->output-path go-drv))))
|
||||
(derivation->output-path go-drv))))
|
||||
(derivation store name guile
|
||||
`("--no-auto-compile"
|
||||
,@(if mod-dir `("-L" ,mod-dir) '())
|
||||
|
|
|
|||
|
|
@ -25,7 +25,6 @@ (define-module (guix download)
|
|||
#:use-module ((guix build download) #:renamer (symbol-prefix-proc 'build:))
|
||||
#:use-module (guix utils)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-11)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:export (%mirrors
|
||||
url-fetch
|
||||
|
|
@ -212,27 +211,22 @@ (define need-gnutls?
|
|||
((url ...)
|
||||
(any https? url)))))
|
||||
|
||||
(let*-values (((gnutls-drv-path gnutls-drv)
|
||||
(if need-gnutls?
|
||||
(gnutls-derivation store system)
|
||||
(values #f #f)))
|
||||
((gnutls)
|
||||
(and gnutls-drv
|
||||
(derivation-output-path
|
||||
(assoc-ref (derivation-outputs gnutls-drv)
|
||||
"out"))))
|
||||
((env-vars)
|
||||
(if gnutls
|
||||
(let ((dir (string-append gnutls "/share/guile/site")))
|
||||
;; XXX: `GUILE_LOAD_COMPILED_PATH' is overridden
|
||||
;; by `build-expression->derivation', so we can't
|
||||
;; set it here.
|
||||
`(("GUILE_LOAD_PATH" . ,dir)))
|
||||
'())))
|
||||
(let* ((gnutls-drv (if need-gnutls?
|
||||
(gnutls-derivation store system)
|
||||
(values #f #f)))
|
||||
(gnutls (and gnutls-drv
|
||||
(derivation->output-path gnutls-drv "out")))
|
||||
(env-vars (if gnutls
|
||||
(let ((dir (string-append gnutls "/share/guile/site")))
|
||||
;; XXX: `GUILE_LOAD_COMPILED_PATH' is overridden
|
||||
;; by `build-expression->derivation', so we can't
|
||||
;; set it here.
|
||||
`(("GUILE_LOAD_PATH" . ,dir)))
|
||||
'())))
|
||||
(build-expression->derivation store (or name file-name) system
|
||||
builder
|
||||
(if gnutls-drv
|
||||
`(("gnutls" ,gnutls-drv-path))
|
||||
`(("gnutls" ,gnutls-drv))
|
||||
'())
|
||||
#:hash-algo hash-algo
|
||||
#:hash hash
|
||||
|
|
|
|||
|
|
@ -26,7 +26,6 @@ (define-module (guix packages)
|
|||
#:use-module (ice-9 match)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-9 gnu)
|
||||
#:use-module (srfi srfi-11)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:use-module (srfi srfi-34)
|
||||
#:use-module (srfi srfi-35)
|
||||
|
|
@ -370,8 +369,8 @@ (define derivation
|
|||
|
||||
(define* (package-derivation store package
|
||||
#:optional (system (%current-system)))
|
||||
"Return the derivation path and corresponding <derivation> object of
|
||||
PACKAGE for SYSTEM."
|
||||
"Return the <derivation> object of PACKAGE for SYSTEM."
|
||||
|
||||
;; Compute the derivation and cache the result. Caching is important
|
||||
;; because some derivations, such as the implicit inputs of the GNU build
|
||||
;; system, will be queried many, many times in a row.
|
||||
|
|
@ -468,7 +467,5 @@ (define* (package-output store package output
|
|||
"Return the output path of PACKAGE's OUTPUT for SYSTEM---where OUTPUT is the
|
||||
symbolic output name, such as \"out\". Note that this procedure calls
|
||||
`package-derivation', which is costly."
|
||||
(let-values (((_ drv)
|
||||
(package-derivation store package system)))
|
||||
(derivation-output-path
|
||||
(assoc-ref (derivation-outputs drv) output))))
|
||||
(let ((drv (package-derivation store package system)))
|
||||
(derivation->output-path drv output)))
|
||||
|
|
|
|||
|
|
@ -250,7 +250,7 @@ (define package->derivation
|
|||
(derivations-from-package-expressions
|
||||
str package->derivation sys src?))
|
||||
(('argument . (? derivation-path? drv))
|
||||
drv)
|
||||
(call-with-input-file drv read-derivation))
|
||||
(('argument . (? string? x))
|
||||
(let ((p (find-package x)))
|
||||
(if src?
|
||||
|
|
@ -280,24 +280,23 @@ (define package->derivation
|
|||
|
||||
(if (assoc-ref opts 'derivations-only?)
|
||||
(begin
|
||||
(format #t "~{~a~%~}" drv)
|
||||
(format #t "~{~a~%~}" (map derivation-file-name drv))
|
||||
(for-each (cut register-root <> <>)
|
||||
(map list drv) roots))
|
||||
(map (compose list derivation-file-name) drv)
|
||||
roots))
|
||||
(or (assoc-ref opts 'dry-run?)
|
||||
(and (build-derivations (%store) drv)
|
||||
(for-each (lambda (d)
|
||||
(let ((drv (call-with-input-file d
|
||||
read-derivation)))
|
||||
(format #t "~{~a~%~}"
|
||||
(map (match-lambda
|
||||
((out-name . out)
|
||||
(derivation-path->output-path
|
||||
d out-name)))
|
||||
(derivation-outputs drv)))))
|
||||
(format #t "~{~a~%~}"
|
||||
(map (match-lambda
|
||||
((out-name . out)
|
||||
(derivation->output-path
|
||||
d out-name)))
|
||||
(derivation-outputs d))))
|
||||
drv)
|
||||
(for-each (cut register-root <> <>)
|
||||
(map (lambda (drv)
|
||||
(map cdr
|
||||
(derivation-path->output-paths drv)))
|
||||
(derivation->output-paths drv)))
|
||||
drv)
|
||||
roots)))))))))
|
||||
|
|
|
|||
|
|
@ -234,12 +234,9 @@ (define (switch-link)
|
|||
(_ "nothing to do: already at the empty profile~%")))
|
||||
((or (zero? previous-number) ; going to emptiness
|
||||
(not (file-exists? previous-generation)))
|
||||
(let*-values (((drv-path drv)
|
||||
(profile-derivation (%store) '()))
|
||||
((prof)
|
||||
(derivation-output-path
|
||||
(assoc-ref (derivation-outputs drv) "out"))))
|
||||
(when (not (build-derivations (%store) (list drv-path)))
|
||||
(let* ((drv (profile-derivation (%store) '()))
|
||||
(prof (derivation->output-path drv "out")))
|
||||
(when (not (build-derivations (%store) (list drv)))
|
||||
(leave (_ "failed to build the empty profile~%")))
|
||||
|
||||
(switch-symlinks previous-generation prof)
|
||||
|
|
@ -558,7 +555,7 @@ (define (parse-options)
|
|||
|
||||
(define (guile-missing?)
|
||||
;; Return #t if %GUILE-FOR-BUILD is not available yet.
|
||||
(let ((out (derivation-path->output-path (%guile-for-build))))
|
||||
(let ((out (derivation->output-path (%guile-for-build))))
|
||||
(not (valid-path? (%store) out))))
|
||||
|
||||
(define newest-available-packages
|
||||
|
|
@ -617,7 +614,7 @@ (define (upgradeable? name current-version current-path)
|
|||
(case (version-compare candidate-version current-version)
|
||||
((>) #t)
|
||||
((<) #f)
|
||||
((=) (let ((candidate-path (derivation-path->output-path
|
||||
((=) (let ((candidate-path (derivation->output-path
|
||||
(package-derivation (%store) pkg))))
|
||||
(not (string=? current-path candidate-path))))))
|
||||
(#f #f)))
|
||||
|
|
@ -808,7 +805,7 @@ (define (show-what-to-remove/install remove install dry-run?)
|
|||
(match tuple
|
||||
((name version sub-drv _ (deps ...))
|
||||
(let ((output-path
|
||||
(derivation-path->output-path
|
||||
(derivation->output-path
|
||||
drv sub-drv)))
|
||||
`(,name ,version ,sub-drv ,output-path
|
||||
,(canonicalize-deps deps))))))
|
||||
|
|
@ -841,11 +838,11 @@ (define (show-what-to-remove/install remove install dry-run?)
|
|||
(or dry-run?
|
||||
(and (build-derivations (%store) drv)
|
||||
(let* ((prof-drv (profile-derivation (%store) packages))
|
||||
(prof (derivation-path->output-path prof-drv))
|
||||
(prof (derivation->output-path prof-drv))
|
||||
(old-drv (profile-derivation
|
||||
(%store) (manifest-packages
|
||||
(profile-manifest profile))))
|
||||
(old-prof (derivation-path->output-path old-drv))
|
||||
(old-prof (derivation->output-path old-drv))
|
||||
(number (generation-number profile))
|
||||
|
||||
;; Always use NUMBER + 1 for the new profile,
|
||||
|
|
|
|||
34
guix/ui.scm
34
guix/ui.scm
|
|
@ -210,27 +210,27 @@ (define* (show-what-to-build store drv
|
|||
otherwise. When USE-SUBSTITUTES?, check and report what is prerequisites are
|
||||
available for download."
|
||||
(let*-values (((build download)
|
||||
(fold2 (lambda (drv-path build download)
|
||||
(let ((drv (call-with-input-file drv-path
|
||||
read-derivation)))
|
||||
(let-values (((b d)
|
||||
(derivation-prerequisites-to-build
|
||||
store drv
|
||||
#:use-substitutes?
|
||||
use-substitutes?)))
|
||||
(values (append b build)
|
||||
(append d download)))))
|
||||
(fold2 (lambda (drv build download)
|
||||
(let-values (((b d)
|
||||
(derivation-prerequisites-to-build
|
||||
store drv
|
||||
#:use-substitutes?
|
||||
use-substitutes?)))
|
||||
(values (append b build)
|
||||
(append d download))))
|
||||
'() '()
|
||||
drv))
|
||||
((build) ; add the DRV themselves
|
||||
(delete-duplicates
|
||||
(append (remove (compose (lambda (out)
|
||||
(or (valid-path? store out)
|
||||
(and use-substitutes?
|
||||
(has-substitutes? store
|
||||
out))))
|
||||
derivation-path->output-path)
|
||||
drv)
|
||||
(append (map derivation-file-name
|
||||
(remove (lambda (drv)
|
||||
(let ((out (derivation->output-path
|
||||
drv)))
|
||||
(or (valid-path? store out)
|
||||
(and use-substitutes?
|
||||
(has-substitutes? store
|
||||
out)))))
|
||||
drv))
|
||||
(map derivation-input-path build))))
|
||||
((download) ; add the references of DOWNLOAD
|
||||
(if use-substitutes?
|
||||
|
|
|
|||
|
|
@ -70,10 +70,10 @@ (define network-reachable?
|
|||
"ftp://ftp.gnu.org/gnu/hello/hello-2.8.tar.gz"))
|
||||
(hash (nix-base32-string->bytevector
|
||||
"0wqd8sjmxfskrflaxywc7gqw7sfawrfvdxd9skxawzfgyy0pzdz6"))
|
||||
(drv-path (url-fetch %store url 'sha256 hash
|
||||
(drv (url-fetch %store url 'sha256 hash
|
||||
#:guile %bootstrap-guile))
|
||||
(out-path (derivation-path->output-path drv-path)))
|
||||
(and (build-derivations %store (list drv-path))
|
||||
(out-path (derivation->output-path drv)))
|
||||
(and (build-derivations %store (list drv))
|
||||
(file-exists? out-path)
|
||||
(valid-path? %store out-path))))
|
||||
|
||||
|
|
@ -93,7 +93,7 @@ (define network-reachable?
|
|||
#:implicit-inputs? #f
|
||||
#:guile %bootstrap-guile
|
||||
#:search-paths %bootstrap-search-paths))
|
||||
(out (derivation-path->output-path build)))
|
||||
(out (derivation->output-path build)))
|
||||
(and (build-derivations %store (list (pk 'hello-drv build)))
|
||||
(valid-path? %store out)
|
||||
(file-exists? (string-append out "/bin/hello")))))
|
||||
|
|
|
|||
|
|
@ -110,31 +110,27 @@ (define prefix-len (string-length dir))
|
|||
(let* ((builder (add-text-to-store %store "my-builder.sh"
|
||||
"echo hello, world\n"
|
||||
'()))
|
||||
(drv-path (derivation %store "foo"
|
||||
(drv (derivation %store "foo"
|
||||
%bash `("-e" ,builder)
|
||||
#:env-vars '(("HOME" . "/homeless")))))
|
||||
(and (store-path? drv-path)
|
||||
(valid-path? %store drv-path))))
|
||||
(and (store-path? (derivation-file-name drv))
|
||||
(valid-path? %store (derivation-file-name drv)))))
|
||||
|
||||
(test-assert "build derivation with 1 source"
|
||||
(let*-values (((builder)
|
||||
(add-text-to-store %store "my-builder.sh"
|
||||
"echo hello, world > \"$out\"\n"
|
||||
'()))
|
||||
((drv-path drv)
|
||||
(derivation %store "foo"
|
||||
%bash `(,builder)
|
||||
#:env-vars '(("HOME" . "/homeless")
|
||||
("zzz" . "Z!")
|
||||
("AAA" . "A!"))
|
||||
#:inputs `((,builder))))
|
||||
((succeeded?)
|
||||
(build-derivations %store (list drv-path))))
|
||||
(let* ((builder (add-text-to-store %store "my-builder.sh"
|
||||
"echo hello, world > \"$out\"\n"
|
||||
'()))
|
||||
(drv (derivation %store "foo"
|
||||
%bash `(,builder)
|
||||
#:env-vars '(("HOME" . "/homeless")
|
||||
("zzz" . "Z!")
|
||||
("AAA" . "A!"))
|
||||
#:inputs `((,builder))))
|
||||
(succeeded?
|
||||
(build-derivations %store (list drv))))
|
||||
(and succeeded?
|
||||
(let ((path (derivation-output-path
|
||||
(assoc-ref (derivation-outputs drv) "out"))))
|
||||
(let ((path (derivation->output-path drv)))
|
||||
(and (valid-path? %store path)
|
||||
(string=? (derivation-file-name drv) drv-path)
|
||||
(string=? (call-with-input-file path read-line)
|
||||
"hello, world"))))))
|
||||
|
||||
|
|
@ -146,7 +142,7 @@ (define prefix-len (string-length dir))
|
|||
(input (search-path %load-path "ice-9/boot-9.scm"))
|
||||
(input* (add-to-store %store (basename input)
|
||||
#t "sha256" input))
|
||||
(drv-path (derivation %store "derivation-with-input-file"
|
||||
(drv (derivation %store "derivation-with-input-file"
|
||||
%bash `(,builder)
|
||||
|
||||
;; Cheat to pass the actual file name to the
|
||||
|
|
@ -155,22 +151,22 @@ (define prefix-len (string-length dir))
|
|||
|
||||
#:inputs `((,builder)
|
||||
(,input))))) ; ← local file name
|
||||
(and (build-derivations %store (list drv-path))
|
||||
(and (build-derivations %store (list drv))
|
||||
;; Note: we can't compare the files because the above trick alters
|
||||
;; the contents.
|
||||
(valid-path? %store (derivation-path->output-path drv-path)))))
|
||||
(valid-path? %store (derivation->output-path drv)))))
|
||||
|
||||
(test-assert "fixed-output derivation"
|
||||
(let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
|
||||
"echo -n hello > $out" '()))
|
||||
(hash (sha256 (string->utf8 "hello")))
|
||||
(drv-path (derivation %store "fixed"
|
||||
(drv (derivation %store "fixed"
|
||||
%bash `(,builder)
|
||||
#:inputs `((,builder)) ; optional
|
||||
#:hash hash #:hash-algo 'sha256))
|
||||
(succeeded? (build-derivations %store (list drv-path))))
|
||||
(succeeded? (build-derivations %store (list drv))))
|
||||
(and succeeded?
|
||||
(let ((p (derivation-path->output-path drv-path)))
|
||||
(let ((p (derivation->output-path drv)))
|
||||
(and (equal? (string->utf8 "hello")
|
||||
(call-with-input-file p get-bytevector-all))
|
||||
(bytevector? (query-path-hash %store p)))))))
|
||||
|
|
@ -181,17 +177,16 @@ (define prefix-len (string-length dir))
|
|||
(builder2 (add-text-to-store %store "fixed-builder2.sh"
|
||||
"echo hey; echo -n hello > $out" '()))
|
||||
(hash (sha256 (string->utf8 "hello")))
|
||||
(drv-path1 (derivation %store "fixed"
|
||||
(drv1 (derivation %store "fixed"
|
||||
%bash `(,builder1)
|
||||
#:hash hash #:hash-algo 'sha256))
|
||||
(drv-path2 (derivation %store "fixed"
|
||||
(drv2 (derivation %store "fixed"
|
||||
%bash `(,builder2)
|
||||
#:hash hash #:hash-algo 'sha256))
|
||||
(succeeded? (build-derivations %store
|
||||
(list drv-path1 drv-path2))))
|
||||
(succeeded? (build-derivations %store (list drv1 drv2))))
|
||||
(and succeeded?
|
||||
(equal? (derivation-path->output-path drv-path1)
|
||||
(derivation-path->output-path drv-path2)))))
|
||||
(equal? (derivation->output-path drv1)
|
||||
(derivation->output-path drv2)))))
|
||||
|
||||
(test-assert "derivation with a fixed-output input"
|
||||
;; A derivation D using a fixed-output derivation F doesn't has the same
|
||||
|
|
@ -208,7 +203,7 @@ (define prefix-len (string-length dir))
|
|||
(fixed2 (derivation %store "fixed"
|
||||
%bash `(,builder2)
|
||||
#:hash hash #:hash-algo 'sha256))
|
||||
(fixed-out (derivation-path->output-path fixed1))
|
||||
(fixed-out (derivation->output-path fixed1))
|
||||
(builder3 (add-text-to-store
|
||||
%store "final-builder.sh"
|
||||
;; Use Bash hackery to avoid Coreutils.
|
||||
|
|
@ -224,26 +219,26 @@ (define prefix-len (string-length dir))
|
|||
(succeeded? (build-derivations %store
|
||||
(list final1 final2))))
|
||||
(and succeeded?
|
||||
(equal? (derivation-path->output-path final1)
|
||||
(derivation-path->output-path final2)))))
|
||||
(equal? (derivation->output-path final1)
|
||||
(derivation->output-path final2)))))
|
||||
|
||||
(test-assert "multiple-output derivation"
|
||||
(let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
|
||||
"echo one > $out ; echo two > $second"
|
||||
'()))
|
||||
(drv-path (derivation %store "fixed"
|
||||
(drv (derivation %store "fixed"
|
||||
%bash `(,builder)
|
||||
#:env-vars '(("HOME" . "/homeless")
|
||||
("zzz" . "Z!")
|
||||
("AAA" . "A!"))
|
||||
#:inputs `((,builder))
|
||||
#:outputs '("out" "second")))
|
||||
(succeeded? (build-derivations %store (list drv-path))))
|
||||
(succeeded? (build-derivations %store (list drv))))
|
||||
(and succeeded?
|
||||
(let ((one (derivation-path->output-path drv-path "out"))
|
||||
(two (derivation-path->output-path drv-path "second")))
|
||||
(let ((one (derivation->output-path drv "out"))
|
||||
(two (derivation->output-path drv "second")))
|
||||
(and (lset= equal?
|
||||
(derivation-path->output-paths drv-path)
|
||||
(derivation->output-paths drv)
|
||||
`(("out" . ,one) ("second" . ,two)))
|
||||
(eq? 'one (call-with-input-file one read))
|
||||
(eq? 'two (call-with-input-file two read)))))))
|
||||
|
|
@ -254,14 +249,14 @@ (define prefix-len (string-length dir))
|
|||
(let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
|
||||
"echo one > $out ; echo two > $AAA"
|
||||
'()))
|
||||
(drv-path (derivation %store "fixed"
|
||||
(drv (derivation %store "fixed"
|
||||
%bash `(,builder)
|
||||
#:inputs `((,builder))
|
||||
#:outputs '("out" "AAA")))
|
||||
(succeeded? (build-derivations %store (list drv-path))))
|
||||
(succeeded? (build-derivations %store (list drv))))
|
||||
(and succeeded?
|
||||
(let ((one (derivation-path->output-path drv-path "out"))
|
||||
(two (derivation-path->output-path drv-path "AAA")))
|
||||
(let ((one (derivation->output-path drv "out"))
|
||||
(two (derivation->output-path drv "AAA")))
|
||||
(and (eq? 'one (call-with-input-file one read))
|
||||
(eq? 'two (call-with-input-file two read)))))))
|
||||
|
||||
|
|
@ -283,17 +278,17 @@ (define prefix-len (string-length dir))
|
|||
(udrv (derivation %store "multiple-output-user"
|
||||
%bash `(,builder2)
|
||||
#:env-vars `(("one"
|
||||
. ,(derivation-path->output-path
|
||||
. ,(derivation->output-path
|
||||
mdrv "out"))
|
||||
("two"
|
||||
. ,(derivation-path->output-path
|
||||
. ,(derivation->output-path
|
||||
mdrv "two")))
|
||||
#:inputs `((,builder2)
|
||||
;; two occurrences of MDRV:
|
||||
(,mdrv)
|
||||
(,mdrv "two")))))
|
||||
(and (build-derivations %store (list (pk 'udrv udrv)))
|
||||
(let ((p (derivation-path->output-path udrv)))
|
||||
(let ((p (derivation->output-path udrv)))
|
||||
(and (valid-path? %store p)
|
||||
(equal? '(one two) (call-with-input-file p read)))))))
|
||||
|
||||
|
|
@ -318,7 +313,7 @@ (define prefix-len (string-length dir))
|
|||
("input1" . ,input1)
|
||||
("input2" . ,input2))
|
||||
#:inputs `((,%bash) (,builder))))
|
||||
(out (derivation-path->output-path drv)))
|
||||
(out (derivation->output-path drv)))
|
||||
(define (deps path . deps)
|
||||
(let ((count (length deps)))
|
||||
(string-append path "\n\n" (number->string count) "\n"
|
||||
|
|
@ -361,31 +356,30 @@ (define %coreutils
|
|||
(add-text-to-store %store "build-with-coreutils.sh"
|
||||
"echo $PATH ; mkdir --version ; mkdir $out ; touch $out/good"
|
||||
'()))
|
||||
(drv-path
|
||||
(drv
|
||||
(derivation %store "foo"
|
||||
%bash `(,builder)
|
||||
#:env-vars `(("PATH" .
|
||||
,(string-append
|
||||
(derivation-path->output-path %coreutils)
|
||||
(derivation->output-path %coreutils)
|
||||
"/bin")))
|
||||
#:inputs `((,builder)
|
||||
(,%coreutils))))
|
||||
(succeeded?
|
||||
(build-derivations %store (list drv-path))))
|
||||
(build-derivations %store (list drv))))
|
||||
(and succeeded?
|
||||
(let ((p (derivation-path->output-path drv-path)))
|
||||
(let ((p (derivation->output-path drv)))
|
||||
(and (valid-path? %store p)
|
||||
(file-exists? (string-append p "/good")))))))
|
||||
|
||||
(test-skip (if (%guile-for-build) 0 8))
|
||||
|
||||
(test-assert "build-expression->derivation and derivation-prerequisites"
|
||||
(let-values (((drv-path drv)
|
||||
(build-expression->derivation %store "fail" (%current-system)
|
||||
#f '())))
|
||||
(let ((drv (build-expression->derivation %store "fail" (%current-system)
|
||||
#f '())))
|
||||
(any (match-lambda
|
||||
(($ <derivation-input> path)
|
||||
(string=? path (%guile-for-build))))
|
||||
(string=? path (derivation-file-name (%guile-for-build)))))
|
||||
(derivation-prerequisites drv))))
|
||||
|
||||
(test-assert "build-expression->derivation without inputs"
|
||||
|
|
@ -394,11 +388,11 @@ (define %coreutils
|
|||
(call-with-output-file (string-append %output "/test")
|
||||
(lambda (p)
|
||||
(display '(hello guix) p)))))
|
||||
(drv-path (build-expression->derivation %store "goo" (%current-system)
|
||||
(drv (build-expression->derivation %store "goo" (%current-system)
|
||||
builder '()))
|
||||
(succeeded? (build-derivations %store (list drv-path))))
|
||||
(succeeded? (build-derivations %store (list drv))))
|
||||
(and succeeded?
|
||||
(let ((p (derivation-path->output-path drv-path)))
|
||||
(let ((p (derivation->output-path drv)))
|
||||
(equal? '(hello guix)
|
||||
(call-with-input-file (string-append p "/test") read))))))
|
||||
|
||||
|
|
@ -407,43 +401,35 @@ (define %coreutils
|
|||
(set-build-options s #:max-silent-time 1)
|
||||
s))
|
||||
(builder '(sleep 100))
|
||||
(drv-path (build-expression->derivation %store "silent"
|
||||
(drv (build-expression->derivation %store "silent"
|
||||
(%current-system)
|
||||
builder '()))
|
||||
(out-path (derivation-path->output-path drv-path)))
|
||||
(out-path (derivation->output-path drv)))
|
||||
(guard (c ((nix-protocol-error? c)
|
||||
(and (string-contains (nix-protocol-error-message c)
|
||||
"failed")
|
||||
(not (valid-path? store out-path)))))
|
||||
(build-derivations %store (list drv-path)))))
|
||||
(build-derivations %store (list drv)))))
|
||||
|
||||
(test-assert "build-expression->derivation and derivation-prerequisites-to-build"
|
||||
(let-values (((drv-path drv)
|
||||
(build-expression->derivation %store "fail" (%current-system)
|
||||
#f '())))
|
||||
(let ((drv (build-expression->derivation %store "fail" (%current-system)
|
||||
#f '())))
|
||||
;; The only direct dependency is (%guile-for-build) and it's already
|
||||
;; built.
|
||||
(null? (derivation-prerequisites-to-build %store drv))))
|
||||
|
||||
(test-assert "derivation-prerequisites-to-build when outputs already present"
|
||||
(let*-values (((builder)
|
||||
'(begin (mkdir %output) #t))
|
||||
((input-drv-path input-drv)
|
||||
(build-expression->derivation %store "input"
|
||||
(%current-system)
|
||||
builder '()))
|
||||
((input-path)
|
||||
(derivation-output-path
|
||||
(assoc-ref (derivation-outputs input-drv)
|
||||
"out")))
|
||||
((drv-path drv)
|
||||
(build-expression->derivation %store "something"
|
||||
(%current-system)
|
||||
builder
|
||||
`(("i" ,input-drv-path))))
|
||||
((output)
|
||||
(derivation-output-path
|
||||
(assoc-ref (derivation-outputs drv) "out"))))
|
||||
(let* ((builder '(begin (mkdir %output) #t))
|
||||
(input-drv (build-expression->derivation %store "input"
|
||||
(%current-system)
|
||||
builder '()))
|
||||
(input-path (derivation-output-path
|
||||
(assoc-ref (derivation-outputs input-drv)
|
||||
"out")))
|
||||
(drv (build-expression->derivation %store "something"
|
||||
(%current-system) builder
|
||||
`(("i" ,input-drv))))
|
||||
(output (derivation->output-path drv)))
|
||||
;; Make sure these things are not already built.
|
||||
(when (valid-path? %store input-path)
|
||||
(delete-paths %store (list input-path)))
|
||||
|
|
@ -452,10 +438,10 @@ (define %coreutils
|
|||
|
||||
(and (equal? (map derivation-input-path
|
||||
(derivation-prerequisites-to-build %store drv))
|
||||
(list input-drv-path))
|
||||
(list (derivation-file-name input-drv)))
|
||||
|
||||
;; Build DRV and delete its input.
|
||||
(build-derivations %store (list drv-path))
|
||||
(build-derivations %store (list drv))
|
||||
(delete-paths %store (list input-path))
|
||||
(not (valid-path? %store input-path))
|
||||
|
||||
|
|
@ -465,17 +451,12 @@ (define %coreutils
|
|||
|
||||
(test-skip (if (getenv "GUIX_BINARY_SUBSTITUTE_URL") 0 1))
|
||||
(test-assert "derivation-prerequisites-to-build and substitutes"
|
||||
(let*-values (((store)
|
||||
(open-connection))
|
||||
((drv-path drv)
|
||||
(build-expression->derivation store "prereq-subst"
|
||||
(let* ((store (open-connection))
|
||||
(drv (build-expression->derivation store "prereq-subst"
|
||||
(%current-system)
|
||||
(random 1000) '()))
|
||||
((output)
|
||||
(derivation-output-path
|
||||
(assoc-ref (derivation-outputs drv) "out")))
|
||||
((dir)
|
||||
(and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL")
|
||||
(output (derivation->output-path drv))
|
||||
(dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL")
|
||||
(compose uri-path string->uri))))
|
||||
;; Create fake substituter data, to be read by `substitute-binary'.
|
||||
(call-with-output-file (string-append dir "/nix-cache-info")
|
||||
|
|
@ -495,7 +476,8 @@ (define %coreutils
|
|||
output ; StorePath
|
||||
(string-append dir "/example.nar") ; URL
|
||||
(%current-system) ; System
|
||||
(basename drv-path)))) ; Deriver
|
||||
(basename
|
||||
(derivation-file-name drv))))) ; Deriver
|
||||
|
||||
(let-values (((build download)
|
||||
(derivation-prerequisites-to-build store drv))
|
||||
|
|
@ -512,16 +494,16 @@ (define %coreutils
|
|||
(let* ((builder '(begin
|
||||
(mkdir %output)
|
||||
#f)) ; fail!
|
||||
(drv-path (build-expression->derivation %store "fail" (%current-system)
|
||||
(drv (build-expression->derivation %store "fail" (%current-system)
|
||||
builder '()))
|
||||
(out-path (derivation-path->output-path drv-path)))
|
||||
(out-path (derivation->output-path drv)))
|
||||
(guard (c ((nix-protocol-error? c)
|
||||
;; Note that the output path may exist at this point, but it
|
||||
;; is invalid.
|
||||
(and (string-match "build .* failed"
|
||||
(nix-protocol-error-message c))
|
||||
(not (valid-path? %store out-path)))))
|
||||
(build-derivations %store (list drv-path))
|
||||
(build-derivations %store (list drv))
|
||||
#f)))
|
||||
|
||||
(test-assert "build-expression->derivation with two outputs"
|
||||
|
|
@ -532,15 +514,15 @@ (define %coreutils
|
|||
(call-with-output-file (assoc-ref %outputs "second")
|
||||
(lambda (p)
|
||||
(display '(world) p)))))
|
||||
(drv-path (build-expression->derivation %store "double"
|
||||
(drv (build-expression->derivation %store "double"
|
||||
(%current-system)
|
||||
builder '()
|
||||
#:outputs '("out"
|
||||
"second")))
|
||||
(succeeded? (build-derivations %store (list drv-path))))
|
||||
(succeeded? (build-derivations %store (list drv))))
|
||||
(and succeeded?
|
||||
(let ((one (derivation-path->output-path drv-path))
|
||||
(two (derivation-path->output-path drv-path "second")))
|
||||
(let ((one (derivation->output-path drv))
|
||||
(two (derivation->output-path drv "second")))
|
||||
(and (equal? '(hello) (call-with-input-file one read))
|
||||
(equal? '(world) (call-with-input-file two read)))))))
|
||||
|
||||
|
|
@ -553,12 +535,12 @@ (define %coreutils
|
|||
(dup2 (port->fdes p) 1)
|
||||
(execl (string-append cu "/bin/uname")
|
||||
"uname" "-a")))))
|
||||
(drv-path (build-expression->derivation %store "uname" (%current-system)
|
||||
(drv (build-expression->derivation %store "uname" (%current-system)
|
||||
builder
|
||||
`(("cu" ,%coreutils))))
|
||||
(succeeded? (build-derivations %store (list drv-path))))
|
||||
(succeeded? (build-derivations %store (list drv))))
|
||||
(and succeeded?
|
||||
(let ((p (derivation-path->output-path drv-path)))
|
||||
(let ((p (derivation->output-path drv)))
|
||||
(string-contains (call-with-input-file p read-line) "GNU")))))
|
||||
|
||||
(test-assert "imported-files"
|
||||
|
|
@ -567,9 +549,9 @@ (define %coreutils
|
|||
"guix/derivations.scm"))
|
||||
("p/q" . ,(search-path %load-path "guix.scm"))
|
||||
("p/z" . ,(search-path %load-path "guix/store.scm"))))
|
||||
(drv-path (imported-files %store files)))
|
||||
(and (build-derivations %store (list drv-path))
|
||||
(let ((dir (derivation-path->output-path drv-path)))
|
||||
(drv (imported-files %store files)))
|
||||
(and (build-derivations %store (list drv))
|
||||
(let ((dir (derivation->output-path drv)))
|
||||
(every (match-lambda
|
||||
((path . source)
|
||||
(equal? (call-with-input-file (string-append dir "/" path)
|
||||
|
|
@ -584,14 +566,13 @@ (define %coreutils
|
|||
(let ((out (assoc-ref %outputs "out")))
|
||||
(mkdir-p (string-append out "/guile/guix/nix"))
|
||||
#t)))
|
||||
(drv-path (build-expression->derivation %store
|
||||
"test-with-modules"
|
||||
(drv (build-expression->derivation %store "test-with-modules"
|
||||
(%current-system)
|
||||
builder '()
|
||||
#:modules
|
||||
'((guix build utils)))))
|
||||
(and (build-derivations %store (list drv-path))
|
||||
(let* ((p (derivation-path->output-path drv-path))
|
||||
(and (build-derivations %store (list drv))
|
||||
(let* ((p (derivation->output-path drv))
|
||||
(s (stat (string-append p "/guile/guix/nix"))))
|
||||
(eq? (stat:type s) 'directory)))))
|
||||
|
||||
|
|
@ -615,9 +596,10 @@ (define %coreutils
|
|||
#:hash-algo 'sha256))
|
||||
(succeeded? (build-derivations %store (list input1 input2))))
|
||||
(and succeeded?
|
||||
(not (string=? input1 input2))
|
||||
(string=? (derivation-path->output-path input1)
|
||||
(derivation-path->output-path input2)))))
|
||||
(not (string=? (derivation-file-name input1)
|
||||
(derivation-file-name input2)))
|
||||
(string=? (derivation->output-path input1)
|
||||
(derivation->output-path input2)))))
|
||||
|
||||
(test-assert "build-expression->derivation with a fixed-output input"
|
||||
(let* ((builder1 '(call-with-output-file %output
|
||||
|
|
@ -649,8 +631,11 @@ (define %coreutils
|
|||
(%current-system)
|
||||
builder3
|
||||
`(("input" ,input2)))))
|
||||
(and (string=? (derivation-path->output-path final1)
|
||||
(derivation-path->output-path final2))
|
||||
(and (string=? (derivation->output-path final1)
|
||||
(derivation->output-path final2))
|
||||
(string=? (derivation->output-path final1)
|
||||
(derivation-path->output-path
|
||||
(derivation-file-name final1)))
|
||||
(build-derivations %store (list final1 final2)))))
|
||||
|
||||
(test-assert "build-expression->derivation with #:references-graphs"
|
||||
|
|
@ -662,7 +647,7 @@ (define %coreutils
|
|||
builder '()
|
||||
#:references-graphs
|
||||
`(("input" . ,input))))
|
||||
(out (derivation-path->output-path drv)))
|
||||
(out (derivation->output-path drv)))
|
||||
(define (deps path . deps)
|
||||
(let ((count (length deps)))
|
||||
(string-append path "\n\n" (number->string count) "\n"
|
||||
|
|
|
|||
|
|
@ -121,17 +121,16 @@ (define read-at
|
|||
(package-source package))))
|
||||
(string=? file source)))
|
||||
|
||||
(test-assert "return values"
|
||||
(let-values (((drv-path drv)
|
||||
(package-derivation %store (dummy-package "p"))))
|
||||
(and (derivation-path? drv-path)
|
||||
(derivation? drv))))
|
||||
(test-assert "return value"
|
||||
(let ((drv (package-derivation %store (dummy-package "p"))))
|
||||
(and (derivation? drv)
|
||||
(file-exists? (derivation-file-name drv)))))
|
||||
|
||||
(test-assert "package-output"
|
||||
(let* ((package (dummy-package "p"))
|
||||
(drv-path (package-derivation %store package)))
|
||||
(and (derivation-path? drv-path)
|
||||
(string=? (derivation-path->output-path drv-path)
|
||||
(drv (package-derivation %store package)))
|
||||
(and (derivation? drv)
|
||||
(string=? (derivation->output-path drv)
|
||||
(package-output %store package "out")))))
|
||||
|
||||
(test-assert "trivial"
|
||||
|
|
@ -148,7 +147,7 @@ (define read-at
|
|||
(display '(hello guix) p))))))))
|
||||
(d (package-derivation %store p)))
|
||||
(and (build-derivations %store (list d))
|
||||
(let ((p (pk 'drv d (derivation-path->output-path d))))
|
||||
(let ((p (pk 'drv d (derivation->output-path d))))
|
||||
(equal? '(hello guix)
|
||||
(call-with-input-file (string-append p "/test") read))))))
|
||||
|
||||
|
|
@ -164,7 +163,7 @@ (define read-at
|
|||
(inputs `(("input" ,i)))))
|
||||
(d (package-derivation %store p)))
|
||||
(and (build-derivations %store (list d))
|
||||
(let ((p (pk 'drv d (derivation-path->output-path d))))
|
||||
(let ((p (pk 'drv d (derivation->output-path d))))
|
||||
(equal? (call-with-input-file p get-bytevector-all)
|
||||
(call-with-input-file i get-bytevector-all))))))
|
||||
|
||||
|
|
@ -183,7 +182,7 @@ (define read-at
|
|||
(%current-system)))))))
|
||||
(d (package-derivation %store p)))
|
||||
(and (build-derivations %store (list d))
|
||||
(let ((p (pk 'drv d (derivation-path->output-path d))))
|
||||
(let ((p (pk 'drv d (derivation->output-path d))))
|
||||
(eq? 'hello (call-with-input-file p read))))))
|
||||
|
||||
(test-assert "search paths"
|
||||
|
|
@ -222,20 +221,17 @@ (define read-at
|
|||
(equal? x (collect (package-derivation %store c)))))))
|
||||
|
||||
(test-assert "package-cross-derivation"
|
||||
(let-values (((drv-path drv)
|
||||
(package-cross-derivation %store (dummy-package "p")
|
||||
"mips64el-linux-gnu")))
|
||||
(and (derivation-path? drv-path)
|
||||
(derivation? drv))))
|
||||
(let ((drv (package-cross-derivation %store (dummy-package "p")
|
||||
"mips64el-linux-gnu")))
|
||||
(and (derivation? drv)
|
||||
(file-exists? (derivation-file-name drv)))))
|
||||
|
||||
(test-assert "package-cross-derivation, trivial-build-system"
|
||||
(let ((p (package (inherit (dummy-package "p"))
|
||||
(build-system trivial-build-system)
|
||||
(arguments '(#:builder (exit 1))))))
|
||||
(let-values (((drv-path drv)
|
||||
(package-cross-derivation %store p "mips64el-linux-gnu")))
|
||||
(and (derivation-path? drv-path)
|
||||
(derivation? drv)))))
|
||||
(let ((drv (package-cross-derivation %store p "mips64el-linux-gnu")))
|
||||
(derivation? drv))))
|
||||
|
||||
(test-assert "package-cross-derivation, no cross builder"
|
||||
(let* ((b (build-system (inherit trivial-build-system)
|
||||
|
|
@ -257,7 +253,7 @@ (define read-at
|
|||
(or (location? (package-location gnu-make))
|
||||
(not (package-location gnu-make)))
|
||||
(let* ((drv (package-derivation %store gnu-make))
|
||||
(out (derivation-path->output-path drv)))
|
||||
(out (derivation->output-path drv)))
|
||||
(and (build-derivations %store (list drv))
|
||||
(file-exists? (string-append out "/bin/make")))))))
|
||||
|
||||
|
|
|
|||
|
|
@ -82,7 +82,7 @@ (define (random-text)
|
|||
;; (d1 (derivation %store "link"
|
||||
;; "/bin/sh" `("-e" ,b)
|
||||
;; #:inputs `((,b) (,p1))))
|
||||
;; (p2 (derivation-path->output-path d1)))
|
||||
;; (p2 (derivation->output-path d1)))
|
||||
;; (and (add-temp-root %store p2)
|
||||
;; (build-derivations %store (list d1))
|
||||
;; (valid-path? %store p1)
|
||||
|
|
@ -133,21 +133,21 @@ (define (same? x y)
|
|||
s `("-e" ,b)
|
||||
#:env-vars `(("foo" . ,(random-text)))
|
||||
#:inputs `((,b) (,s))))
|
||||
(o (derivation-path->output-path d)))
|
||||
(o (derivation->output-path d)))
|
||||
(and (build-derivations %store (list d))
|
||||
(equal? (query-derivation-outputs %store d)
|
||||
(equal? (query-derivation-outputs %store (derivation-file-name d))
|
||||
(list o))
|
||||
(equal? (valid-derivers %store o)
|
||||
(list d)))))
|
||||
(list (derivation-file-name d))))))
|
||||
|
||||
(test-assert "no substitutes"
|
||||
(let* ((s (open-connection))
|
||||
(d1 (package-derivation s %bootstrap-guile (%current-system)))
|
||||
(d2 (package-derivation s %bootstrap-glibc (%current-system)))
|
||||
(o (map derivation-path->output-path (list d1 d2))))
|
||||
(o (map derivation->output-path (list d1 d2))))
|
||||
(set-build-options s #:use-substitutes? #f)
|
||||
(and (not (has-substitutes? s d1))
|
||||
(not (has-substitutes? s d2))
|
||||
(and (not (has-substitutes? s (derivation-file-name d1)))
|
||||
(not (has-substitutes? s (derivation-file-name d2)))
|
||||
(null? (substitutable-paths s o))
|
||||
(null? (substitutable-path-info s o)))))
|
||||
|
||||
|
|
@ -156,7 +156,7 @@ (define (same? x y)
|
|||
(test-assert "substitute query"
|
||||
(let* ((s (open-connection))
|
||||
(d (package-derivation s %bootstrap-guile (%current-system)))
|
||||
(o (derivation-path->output-path d))
|
||||
(o (derivation->output-path d))
|
||||
(dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL")
|
||||
(compose uri-path string->uri))))
|
||||
;; Create fake substituter data, to be read by `substitute-binary'.
|
||||
|
|
@ -177,7 +177,8 @@ (define (same? x y)
|
|||
o ; StorePath
|
||||
(string-append dir "/example.nar") ; URL
|
||||
(%current-system) ; System
|
||||
(basename d)))) ; Deriver
|
||||
(basename
|
||||
(derivation-file-name d))))) ; Deriver
|
||||
|
||||
;; Remove entry from the local cache.
|
||||
(false-if-exception
|
||||
|
|
@ -191,7 +192,7 @@ (define (same? x y)
|
|||
(equal? (list o) (substitutable-paths s (list o)))
|
||||
(match (pk 'spi (substitutable-path-info s (list o)))
|
||||
(((? substitutable? s))
|
||||
(and (equal? (substitutable-deriver s) d)
|
||||
(and (string=? (substitutable-deriver s) (derivation-file-name d))
|
||||
(null? (substitutable-references s))
|
||||
(equal? (substitutable-nar-size s) 1234)))))))
|
||||
|
||||
|
|
@ -207,7 +208,7 @@ (define (same? x y)
|
|||
'()
|
||||
#:guile-for-build
|
||||
(package-derivation s %bootstrap-guile (%current-system))))
|
||||
(o (derivation-path->output-path d))
|
||||
(o (derivation->output-path d))
|
||||
(dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL")
|
||||
(compose uri-path string->uri))))
|
||||
;; Create fake substituter data, to be read by `substitute-binary'.
|
||||
|
|
@ -238,7 +239,8 @@ (define (same? x y)
|
|||
(compose bytevector->nix-base32-string sha256
|
||||
get-bytevector-all))
|
||||
(%current-system) ; System
|
||||
(basename d)))) ; Deriver
|
||||
(basename
|
||||
(derivation-file-name d))))) ; Deriver
|
||||
|
||||
;; Make sure we use `substitute-binary'.
|
||||
(set-build-options s #:use-substitutes? #t)
|
||||
|
|
@ -257,7 +259,7 @@ (define (same? x y)
|
|||
'()
|
||||
#:guile-for-build
|
||||
(package-derivation s %bootstrap-guile (%current-system))))
|
||||
(o (derivation-path->output-path d))
|
||||
(o (derivation->output-path d))
|
||||
(dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL")
|
||||
(compose uri-path string->uri))))
|
||||
;; Create fake substituter data, to be read by `substitute-binary'.
|
||||
|
|
@ -279,7 +281,8 @@ (define (same? x y)
|
|||
o ; StorePath
|
||||
"does-not-exist.nar" ; relative URL
|
||||
(%current-system) ; System
|
||||
(basename d)))) ; Deriver
|
||||
(basename
|
||||
(derivation-file-name d))))) ; Deriver
|
||||
|
||||
;; Make sure we use `substitute-binary'.
|
||||
(set-build-options s #:use-substitutes? #t)
|
||||
|
|
|
|||
|
|
@ -108,7 +108,7 @@ (define %store
|
|||
builder inputs
|
||||
#:modules '((guix build union)))))
|
||||
(and (build-derivations %store (list (pk 'drv drv)))
|
||||
(with-directory-excursion (derivation-path->output-path drv)
|
||||
(with-directory-excursion (derivation->output-path drv)
|
||||
(and (file-exists? "bin/touch")
|
||||
(file-exists? "bin/gcc")
|
||||
(file-exists? "bin/ld")
|
||||
|
|
|
|||
Loading…
Reference in a new issue