~ruther/guix-local

59688fc4b5cfac3e05610195a47795f5cc15f338 — Ludovic Courtès 12 years ago 81b66f8
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.
M doc/guix.texi => doc/guix.texi +17 -20
@@ 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

M gnu/system/grub.scm => gnu/system/grub.scm +3 -3
@@ 56,7 56,7 @@ search.file ~a~%"
            (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 @@ search.file ~a~%"
  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

M gnu/system/vm.scm => gnu/system/vm.scm +6 -6
@@ 206,10 206,10 @@ It can be used to provide additional files, such as /etc files."
  (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 @@ It can be used to provide additional files, such as /etc files."

  (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 @@ It can be used to provide additional files, such as /etc files."
                                   (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

M guix/build-system/cmake.scm => guix/build-system/cmake.scm +3 -3
@@ 72,9 72,9 @@ provides a 'CMakeLists.txt' file as its build system."
  (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

M guix/build-system/gnu.scm => guix/build-system/gnu.scm +12 -8
@@ 291,8 291,8 @@ which could lead to gratuitous input divergence."
  (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 @@ which could lead to gratuitous input divergence."
    (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 @@ platform."
       (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 @@ platform."

         (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 @@ platform."
                    `(,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 @@ platform."
    (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)))

M guix/build-system/perl.scm => guix/build-system/perl.scm +2 -2
@@ 62,8 62,8 @@ provides a `Makefile.PL' file as its build system."
    `(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

M guix/build-system/python.scm => guix/build-system/python.scm +2 -2
@@ 120,8 120,8 @@ provides a 'setup.py' file as its build system."
    `(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

M guix/derivations.scm => guix/derivations.scm +56 -23
@@ 58,6 58,8 @@

            read-derivation
            write-derivation
            derivation->output-path
            derivation->output-paths
            derivation-path->output-path
            derivation-path->output-paths
            derivation


@@ 66,7 68,8 @@
            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 @@ that form."
                 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 @@ the derivation called NAME with hash HASH."
                     (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 @@ the build environment in the corresponding file, in a simple text format."
                                  (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 @@ the build environment in the corresponding file, in a simple text format."
                                    (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 @@ they can refer to each other."
                                       #: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 @@ See the `derivation' procedure for the meaning of REFERENCES-GRAPHS."
    (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 @@ See the `derivation' procedure for the meaning of REFERENCES-GRAPHS."
    ;; 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 @@ See the `derivation' procedure for the meaning of REFERENCES-GRAPHS."
                                              (() "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 @@ See the `derivation' procedure for the meaning of REFERENCES-GRAPHS."
                                          #: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) '())

M guix/download.scm => guix/download.scm +13 -19
@@ 25,7 25,6 @@
  #: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 @@ must be a list of symbol/URL-list pairs."
        ((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

M guix/packages.scm => guix/packages.scm +4 -7
@@ 26,7 26,6 @@
  #: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 @@ information in exceptions."

(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 @@ system identifying string)."
  "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)))

M guix/scripts/build.scm => guix/scripts/build.scm +11 -12
@@ 250,7 250,7 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
                                   (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 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))

          (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)))))))))

M guix/scripts/package.scm => guix/scripts/package.scm +8 -11
@@ 234,12 234,9 @@ all of PACKAGES, a list of name/version/output/path/deps tuples."
                   (_ "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 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))

  (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 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
       (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 @@ more information.~%"))
                                 (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 @@ more information.~%"))
          (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,

M guix/ui.scm => guix/ui.scm +17 -17
@@ 210,27 210,27 @@ derivations listed in DRV.  Return #t if there's something to build, #f
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?

M tests/builders.scm => tests/builders.scm +4 -4
@@ 70,10 70,10 @@
                     "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 @@
                              #: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")))))

M tests/derivations.scm => tests/derivations.scm +102 -117
@@ 110,31 110,27 @@
  (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 @@
         (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 @@

                                 #: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 @@
         (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 @@
         (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 @@
         (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 @@
  (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 @@
         (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 @@
                                ("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 @@
          (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 @@
                        (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 @@
                       (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 @@

    (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 @@

(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 @@ Deriver: ~a~%"
                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 @@ Deriver: ~a~%"
  (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 @@ Deriver: ~a~%"
                        (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 @@ Deriver: ~a~%"
                            (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 @@ Deriver: ~a~%"
                                              "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 @@ Deriver: ~a~%"
                      (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 @@ Deriver: ~a~%"
                                                   #: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 @@ Deriver: ~a~%"
                                                  (%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 @@ Deriver: ~a~%"
                                                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"

M tests/packages.scm => tests/packages.scm +17 -21
@@ 121,17 121,16 @@
                                             (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 @@
                       (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 @@
              (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 @@
                                                          (%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 @@
           (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 @@
         (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")))))))


M tests/store.scm => tests/store.scm +17 -14
@@ 82,7 82,7 @@
;;          (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 @@
                        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 @@
(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 @@ Deriver: ~a~%"
                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 @@ Deriver: ~a~%"
         (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 @@ Deriver: ~a~%"
               '()
               #: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 @@ Deriver: ~a~%"
                  (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 @@ Deriver: ~a~%"
               '()
               #: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 @@ Deriver: ~a~%"
                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)

M tests/union.scm => tests/union.scm +1 -1
@@ 108,7 108,7 @@
                                        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")