gnu: waybar: Fix build.
[jackhill/guix/guix.git] / tests / derivations.scm
index d8553b2..9f1104a 100644 (file)
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
 ;;; You should have received a copy of the GNU General Public License
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
+(unsetenv "http_proxy")
+
 (define-module (test-derivations)
   #:use-module (guix derivations)
   #:use-module (guix grafts)
   #:use-module (guix store)
   #:use-module (guix utils)
-  #:use-module (guix hash)
+  #:use-module ((gcrypt hash) #:prefix gcrypt:)
   #:use-module (guix base32)
   #:use-module (guix tests)
+  #:use-module (guix tests http)
   #:use-module ((guix packages) #:select (package-derivation base32))
   #:use-module ((guix build utils) #:select (executable-file?))
-  #:use-module ((gnu packages) #:select (search-bootstrap-binary))
   #:use-module (gnu packages bootstrap)
   #:use-module ((gnu packages guile) #:select (guile-1.8))
   #:use-module (srfi srfi-1)
         (lambda (e1 e2)
           (string<? (car e1) (car e2)))))
 
+;; Avoid collisions with other tests.
+(%http-server-port 10500)
+
 \f
 (test-begin "derivations")
 
 (test-assert "parse & export"
   (let* ((f  (search-path %load-path "tests/test.drv"))
          (b1 (call-with-input-file f get-bytevector-all))
-         (d1 (read-derivation (open-bytevector-input-port b1)))
+         (d1 (read-derivation (open-bytevector-input-port b1)
+                              identity))
          (b2 (call-with-bytevector-output-port (cut write-derivation d1 <>)))
-         (d2 (read-derivation (open-bytevector-input-port b2))))
+         (d2 (read-derivation (open-bytevector-input-port b2)
+                              identity)))
     (and (equal? b1 b2)
          (equal? d1 d2))))
 
 (test-skip (if %store 0 12))
 
 (test-assert "add-to-store, flat"
-  (let* ((file (search-path %load-path "language/tree-il/spec.scm"))
+  ;; Use 'readlink*' in case spec.scm is a symlink, as is the case when Guile
+  ;; was installed with Stow.
+  (let* ((file (readlink*
+                (search-path %load-path "language/tree-il/spec.scm")))
          (drv  (add-to-store %store "flat-test" #f "sha256" file)))
     (and (eq? 'regular (stat:type (stat drv)))
          (valid-path? %store drv)
                  (call-with-input-file drv get-bytevector-all)))))
 
 (test-assert "add-to-store, recursive"
-  (let* ((dir (dirname (search-path %load-path "language/tree-il/spec.scm")))
+  (let* ((dir (dirname
+               (readlink* (search-path %load-path
+                                       "language/tree-il/spec.scm"))))
          (drv (add-to-store %store "dir-tree-test" #t "sha256" dir)))
     (and (eq? 'directory (stat:type (stat drv)))
          (valid-path? %store drv)
                               #:env-vars '(("HOME" . "/homeless")
                                            ("zzz"  . "Z!")
                                            ("AAA"  . "A!"))
-                              #:inputs `((,%bash) (,builder))))
+                              #:sources `(,%bash ,builder)))
          (succeeded?
           (build-derivations %store (list drv))))
     (and succeeded?
                 (string=? (call-with-input-file path read-line)
                           "hello, world"))))))
 
-(test-assert "derivation with local file as input"
-  (let* ((builder    (add-text-to-store
-                      %store "my-builder.sh"
-                      "(while read line ; do echo \"$line\" ; done) < $in > $out"
-                      '()))
-         (input      (search-path %load-path "ice-9/boot-9.scm"))
-         (input*     (add-to-store %store (basename input)
-                                   #t "sha256" input))
-         (drv        (derivation %store "derivation-with-input-file"
-                                 %bash `(,builder)
-
-                                 ;; Cheat to pass the actual file name to the
-                                 ;; builder.
-                                 #:env-vars `(("in" . ,input*))
-
-                                 #:inputs `((,%bash)
-                                            (,builder)
-                                            (,input))))) ; ← local file name
-    (and (build-derivations %store (list drv))
-         ;; Note: we can't compare the files because the above trick alters
-         ;; the contents.
-         (valid-path? %store (derivation->output-path drv)))))
-
 (test-assert "derivation fails but keep going"
   ;; In keep-going mode, 'build-derivations' should fail because of D1, but it
   ;; must return only after D2 has succeeded.
   (with-store store
     (let* ((d1 (derivation %store "fails"
                            %bash `("-c" "false")
-                           #:inputs `((,%bash))))
+                           #:sources (list %bash)))
            (d2 (build-expression->derivation %store "sleep-then-succeed"
                                              `(begin
                                                 ,(random-text)
       (set-build-options %store
                          #:use-substitutes? #f
                          #:keep-going? #t)
-      (guard (c ((nix-protocol-error? c)
-                 (and (= 100 (nix-protocol-error-status c))
-                      (string-contains (nix-protocol-error-message c)
+      (guard (c ((store-protocol-error? c)
+                 (and (= 100 (store-protocol-error-status c))
+                      (string-contains (store-protocol-error-message c)
                                        (derivation-file-name d1))
                       (not (valid-path? %store (derivation->output-path d1)))
                       (valid-path? %store (derivation->output-path d2)))))
                                      '()))
          (drv1    (derivation %store "foo"
                               %bash `(,build1)
-                              #:inputs `((,%bash) (,build1))))
+                              #:sources `(,%bash ,build1)))
          (drv2    (derivation %store "bar"
                               %bash `(,build2)
-                              #:inputs `((,%bash) (,build2)))))
+                              #:sources `(,%bash ,build2))))
     (and (build-derivations %store (list drv1 drv2))
          (let ((file1 (derivation->output-path drv1))
                (file2 (derivation->output-path drv2)))
                 (= (stat:ino (lstat file1))
                    (stat:ino (lstat file2))))))))
 
+(test-equal "built-in-builders"
+  '("download")
+  (built-in-builders %store))
+
+(test-assert "unknown built-in builder"
+  (let ((drv (derivation %store "ohoh" "builtin:does-not-exist" '())))
+    (guard (c ((store-protocol-error? c)
+               (string-contains (store-protocol-error-message c) "failed")))
+      (build-derivations %store (list drv))
+      #f)))
+
+(unless (http-server-can-listen?)
+  (test-skip 1))
+(test-assert "'download' built-in builder"
+  (let ((text (random-text)))
+    (with-http-server `((200 ,text))
+      (let* ((drv (derivation %store "world"
+                              "builtin:download" '()
+                              #:env-vars `(("url"
+                                            . ,(object->string (%local-url))))
+                              #:hash-algo 'sha256
+                              #:hash (gcrypt:sha256 (string->utf8 text)))))
+        (and (build-derivations %store (list drv))
+             (string=? (call-with-input-file (derivation->output-path drv)
+                         get-string-all)
+                       text))))))
+
+(unless (http-server-can-listen?)
+  (test-skip 1))
+(test-assert "'download' built-in builder, invalid hash"
+  (with-http-server `((200 "hello, world!"))
+    (let* ((drv (derivation %store "world"
+                            "builtin:download" '()
+                            #:env-vars `(("url"
+                                          . ,(object->string (%local-url))))
+                            #:hash-algo 'sha256
+                            #:hash (gcrypt:sha256 (random-bytevector 100))))) ;wrong
+      (guard (c ((store-protocol-error? c)
+                 (string-contains (store-protocol-error-message c) "failed")))
+        (build-derivations %store (list drv))
+        #f))))
+
+(unless (http-server-can-listen?)
+  (test-skip 1))
+(test-assert "'download' built-in builder, not found"
+  (with-http-server '((404 "not found"))
+    (let* ((drv (derivation %store "will-never-be-found"
+                            "builtin:download" '()
+                            #:env-vars `(("url"
+                                          . ,(object->string (%local-url))))
+                            #:hash-algo 'sha256
+                            #:hash (gcrypt:sha256 (random-bytevector 100)))))
+      (guard (c ((store-protocol-error? c)
+                 (string-contains (store-protocol-error-message (pk c)) "failed")))
+        (build-derivations %store (list drv))
+        #f))))
+
+(test-assert "'download' built-in builder, not fixed-output"
+  (let* ((source (add-text-to-store %store "hello" "hi!"))
+         (url    (string-append "file://" source))
+         (drv    (derivation %store "world"
+                             "builtin:download" '()
+                             #:env-vars `(("url" . ,(object->string url))))))
+    (guard (c ((store-protocol-error? c)
+               (string-contains (store-protocol-error-message c) "failed")))
+      (build-derivations %store (list drv))
+      #f)))
+
+(unless (http-server-can-listen?)
+  (test-skip 1))
+(test-assert "'download' built-in builder, check mode"
+  ;; Make sure rebuilding the 'builtin:download' derivation in check mode
+  ;; works.  See <http://bugs.gnu.org/25089>.
+  (let* ((text (random-text))
+         (drv (derivation %store "world"
+                          "builtin:download" '()
+                          #:env-vars `(("url"
+                                        . ,(object->string (%local-url))))
+                          #:hash-algo 'sha256
+                          #:hash (gcrypt:sha256 (string->utf8 text)))))
+    (and (with-http-server `((200 ,text))
+           (build-derivations %store (list drv)))
+         (with-http-server `((200 ,text))
+           (build-derivations %store (list drv)
+                              (build-mode check)))
+         (string=? (call-with-input-file (derivation->output-path drv)
+                     get-string-all)
+                   text))))
+
 (test-equal "derivation-name"
   "foo-0.0"
   (let ((drv (derivation %store "foo-0.0" %bash '())))
 (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")))
+         (hash       (gcrypt:sha256 (string->utf8 "hello")))
          (drv        (derivation %store "fixed"
                                  %bash `(,builder)
-                                 #:inputs `((,builder))
+                                 #:sources (list builder)
                                  #:hash hash #:hash-algo 'sha256)))
     (fixed-output-derivation? 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        (derivation %store "fixed"
-                                 %bash `(,builder)
-                                 #:inputs `((,builder)) ; optional
-                                 #:hash hash #:hash-algo 'sha256))
-         (succeeded? (build-derivations %store (list drv))))
-    (and succeeded?
-         (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)))))))
+(test-equal "fixed-output derivation"
+  '(sha1 sha256 sha512)
+  (map (lambda (hash-algorithm)
+         (let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
+                                            "echo -n hello > $out" '()))
+                (sha256  (gcrypt:sha256 (string->utf8 "hello")))
+                (hash    (gcrypt:bytevector-hash
+                          (string->utf8 "hello")
+                          (gcrypt:lookup-hash-algorithm hash-algorithm)))
+                (drv     (derivation %store
+                                     (string-append
+                                      "fixed-" (symbol->string hash-algorithm))
+                                     %bash `(,builder)
+                                     #:sources `(,builder) ;optional
+                                     #:hash hash
+                                     #:hash-algo hash-algorithm)))
+           (build-derivations %store (list drv))
+           (let ((p (derivation->output-path drv)))
+             (and (bytevector=? (string->utf8 "hello")
+                                (call-with-input-file p get-bytevector-all))
+                  (bytevector? (query-path-hash %store p))
+                  hash-algorithm))))
+       '(sha1 sha256 sha512)))
 
 (test-assert "fixed-output derivation: output paths are equal"
   (let* ((builder1   (add-text-to-store %store "fixed-builder1.sh"
                                         "echo -n hello > $out" '()))
          (builder2   (add-text-to-store %store "fixed-builder2.sh"
                                         "echo hey; echo -n hello > $out" '()))
-         (hash       (sha256 (string->utf8 "hello")))
+         (hash       (gcrypt:sha256 (string->utf8 "hello")))
          (drv1       (derivation %store "fixed"
                                  %bash `(,builder1)
                                  #:hash hash #:hash-algo 'sha256))
 (test-assert "fixed-output derivation, recursive"
   (let* ((builder    (add-text-to-store %store "my-fixed-builder.sh"
                                         "echo -n hello > $out" '()))
-         (hash       (sha256 (string->utf8 "hello")))
+         (hash       (gcrypt:sha256 (string->utf8 "hello")))
          (drv        (derivation %store "fixed-rec"
                                  %bash `(,builder)
-                                 #:inputs `((,builder))
+                                 #:sources (list builder)
                                  #:hash (base32 "0sg9f58l1jj88w6pdrfdpj5x9b1zrwszk84j81zvby36q9whhhqa")
                                  #:hash-algo 'sha256
                                  #:recursive? #t))
                                         "echo -n hello > $out" '()))
          (builder2   (add-text-to-store %store "fixed-builder2.sh"
                                         "echo hey; echo -n hello > $out" '()))
-         (hash       (sha256 (string->utf8 "hello")))
+         (hash       (gcrypt:sha256 (string->utf8 "hello")))
          (fixed1     (derivation %store "fixed"
                                  %bash `(,builder1)
                                  #:hash hash #:hash-algo 'sha256))
          (final1     (derivation %store "final"
                                  %bash `(,builder3)
                                  #:env-vars `(("in" . ,fixed-out))
-                                 #:inputs `((,%bash) (,builder3) (,fixed1))))
+                                 #:sources (list %bash builder3)
+                                 #:inputs (list (derivation-input fixed1))))
          (final2     (derivation %store "final"
                                  %bash `(,builder3)
                                  #:env-vars `(("in" . ,fixed-out))
-                                 #:inputs `((,%bash) (,builder3) (,fixed2))))
+                                 #:sources (list %bash builder3)
+                                 #:inputs (list (derivation-input fixed2))))
          (succeeded? (build-derivations %store
                                         (list final1 final2))))
     (and succeeded?
          (equal? (derivation->output-path final1)
                  (derivation->output-path final2)))))
 
+(test-assert "derivation with duplicate fixed-output inputs"
+  ;; Here we create a derivation that has two inputs, both of which are
+  ;; fixed-output leading to the same result.  This test ensures the hash of
+  ;; that derivation is correctly computed, namely that duplicate inputs are
+  ;; coalesced.  See <https://bugs.gnu.org/36777>.
+  (let* ((builder1   (add-text-to-store %store "fixed-builder1.sh"
+                                        "echo -n hello > $out" '()))
+         (builder2   (add-text-to-store %store "fixed-builder2.sh"
+                                        "echo hey; echo -n hello > $out" '()))
+         (hash       (gcrypt:sha256 (string->utf8 "hello")))
+         (fixed1     (derivation %store "fixed"
+                                 %bash `(,builder1)
+                                 #:hash hash #:hash-algo 'sha256))
+         (fixed2     (derivation %store "fixed"
+                                 %bash `(,builder2)
+                                 #:hash hash #:hash-algo 'sha256))
+         (builder3   (add-text-to-store %store "builder.sh"
+                                        "echo fake builder"))
+         (final      (derivation %store "final"
+                                 %bash `(,builder3)
+                                 #:sources (list %bash builder3)
+                                 #:inputs (list (derivation-input fixed1)
+                                                (derivation-input fixed2)))))
+    (and (derivation? final)
+         (match (derivation-inputs final)
+           (((= derivation-input-derivation one)
+             (= derivation-input-derivation two))
+            (and (not (string=? (derivation-file-name one)
+                                (derivation-file-name two)))
+                 (string=? (derivation->output-path one)
+                           (derivation->output-path two))))))))
+
 (test-assert "multiple-output derivation"
   (let* ((builder    (add-text-to-store %store "my-fixed-builder.sh"
                                         "echo one > $out ; echo two > $second"
                                  #:env-vars '(("HOME" . "/homeless")
                                               ("zzz"  . "Z!")
                                               ("AAA"  . "A!"))
-                                 #:inputs `((,%bash) (,builder))
+                                 #:sources `(,%bash ,builder)
                                  #:outputs '("out" "second")))
          (succeeded? (build-derivations %store (list drv))))
     (and succeeded?
                                         '()))
          (drv        (derivation %store "fixed"
                                  %bash `(,builder)
-                                 #:inputs `((,%bash) (,builder))
+                                 #:sources `(,%bash ,builder)
                                  #:outputs '("out" "AAA")))
          (succeeded? (build-derivations %store (list drv))))
     (and succeeded?
          (inputs  (map (lambda (file)
                          (derivation %store "derivation-input"
                                      %bash '()
-                                     #:inputs `((,%bash) (,file))))
+                                     #:sources `(,%bash ,file)))
                        sources))
          (builder (add-text-to-store %store "builder.sh"
                                      "echo one > $one ; echo two > $two"
                                      '()))
          (drv     (derivation %store "derivation"
                               %bash `(,builder)
-                              #:inputs `((,%bash) (,builder)
-                                         ,@(map list (append sources inputs)))
+                              #:sources `(,%bash ,builder ,@sources)
+                              #:inputs (map derivation-input inputs)
                               #:outputs '("two" "one")))
          (drv*    (call-with-input-file (derivation-file-name drv)
                     read-derivation)))
                                         '()))
          (mdrv       (derivation %store "multiple-output"
                                  %bash `(,builder1)
-                                 #:inputs `((,%bash) (,builder1))
+                                 #:sources (list %bash builder1)
                                  #:outputs '("out" "two")))
          (builder2   (add-text-to-store %store "my-mo-user-builder.sh"
                                         "read x < $one;
                                               ("two"
                                                . ,(derivation->output-path
                                                    mdrv "two")))
-                                 #:inputs `((,%bash)
-                                            (,builder2)
-                                            ;; two occurrences of MDRV:
-                                            (,mdrv)
-                                            (,mdrv "two")))))
+                                 #:sources (list %bash builder2)
+                                 ;; two occurrences of MDRV:
+                                 #:inputs
+                                 (list (derivation-input mdrv)
+                                       (derivation-input mdrv '("two"))))))
     (and (build-derivations %store (list (pk 'udrv udrv)))
          (let ((p (derivation->output-path udrv)))
            (and (valid-path? %store p)
                               `(("bash" . ,%bash)
                                 ("input1" . ,input1)
                                 ("input2" . ,input2))
-                              #:inputs `((,%bash) (,builder))))
+                              #:sources (list %bash builder)))
          (out     (derivation->output-path drv)))
     (define (deps path . deps)
       (let ((count (length deps)))
 (test-assert "derivation #:allowed-references, ok"
   (let ((drv (derivation %store "allowed" %bash
                          '("-c" "echo hello > $out")
-                         #:inputs `((,%bash))
+                         #:sources (list %bash)
                          #:allowed-references '())))
     (build-derivations %store (list drv))))
 
   (let* ((txt (add-text-to-store %store "foo" "Hello, world."))
          (drv (derivation %store "disallowed" %bash
                           `("-c" ,(string-append "echo " txt "> $out"))
-                          #:inputs `((,%bash) (,txt))
+                          #:sources (list %bash txt)
                           #:allowed-references '())))
-    (guard (c ((nix-protocol-error? c)
+    (guard (c ((store-protocol-error? c)
                ;; There's no specific error message to check for.
                #t))
       (build-derivations %store (list drv))
 (test-assert "derivation #:allowed-references, self allowed"
   (let ((drv (derivation %store "allowed" %bash
                          '("-c" "echo $out > $out")
-                         #:inputs `((,%bash))
+                         #:sources (list %bash)
                          #:allowed-references '("out"))))
     (build-derivations %store (list drv))))
 
 (test-assert "derivation #:allowed-references, self not allowed"
   (let ((drv (derivation %store "disallowed" %bash
                          `("-c" ,"echo $out > $out")
-                         #:inputs `((,%bash))
+                         #:sources (list %bash)
                          #:allowed-references '())))
-    (guard (c ((nix-protocol-error? c)
+    (guard (c ((store-protocol-error? c)
                ;; There's no specific error message to check for.
                #t))
       (build-derivations %store (list drv))
 (test-assert "derivation #:disallowed-references, ok"
   (let ((drv (derivation %store "disallowed" %bash
                          '("-c" "echo hello > $out")
-                         #:inputs `((,%bash))
+                         #:sources (list %bash)
                          #:disallowed-references '("out"))))
     (build-derivations %store (list drv))))
 
   (let* ((txt (add-text-to-store %store "foo" "Hello, world."))
          (drv (derivation %store "disdisallowed" %bash
                           `("-c" ,(string-append "echo " txt "> $out"))
-                          #:inputs `((,%bash) (,txt))
+                          #:sources (list %bash txt)
                           #:disallowed-references (list txt))))
-    (guard (c ((nix-protocol-error? c)
+    (guard (c ((store-protocol-error? c)
                ;; There's no specific error message to check for.
                #t))
       (build-derivations %store (list drv))
       #f)))
 
-;; Here we should get the value of $NIX_STATE_DIR that the daemon sees, which
-;; is a unique value for each test process; this value is the same as the one
-;; we see in the process executing this file since it is set by 'test-env'.
+;; Here we should get the value of $GUIX_STATE_DIRECTORY that the daemon sees,
+;; which is a unique value for each test process; this value is the same as
+;; the one we see in the process executing this file since it is set by
+;; 'test-env'.
 (test-equal "derivation #:leaked-env-vars"
-  (getenv "NIX_STATE_DIR")
-  (let* ((value (getenv "NIX_STATE_DIR"))
+  (getenv "GUIX_STATE_DIRECTORY")
+  (let* ((value (getenv "GUIX_STATE_DIRECTORY"))
          (drv   (derivation %store "leaked-env-vars" %bash
-                            '("-c" "echo -n $NIX_STATE_DIR > $out")
-                            #:hash (sha256 (string->utf8 value))
+                            '("-c" "echo -n $GUIX_STATE_DIRECTORY > $out")
+                            #:hash (gcrypt:sha256 (string->utf8 value))
                             #:hash-algo 'sha256
-                            #:inputs `((,%bash))
-                            #:leaked-env-vars '("NIX_STATE_DIR"))))
+                            #:sources (list %bash)
+                            #:leaked-env-vars '("GUIX_STATE_DIRECTORY"))))
     (and (build-derivations %store (list drv))
          (call-with-input-file (derivation->output-path drv)
            get-string-all))))
                                     ,(string-append
                                       (derivation->output-path %coreutils)
                                       "/bin")))
-                      #:inputs `((,builder)
-                                 (,%coreutils))))
+                      #:sources (list builder)
+                      #:inputs (list (derivation-input %coreutils))))
          (succeeded?
           (build-derivations %store (list drv))))
     (and succeeded?
                                   #:modules '((guix module that
                                                     does not exist)))))
 
+(test-equal "build-expression->derivation and builder encoding"
+  '("UTF-8" #t)
+  (let* ((exp '(λ (α) (+ α 1)))
+         (drv (build-expression->derivation %store "foo" exp)))
+    (match (derivation-builder-arguments drv)
+      ((... builder)
+       (with-fluids ((%default-port-encoding "UTF-8"))
+         (call-with-input-file builder
+           (lambda (port)
+             (list (port-encoding port)
+                   (->bool
+                    (string-contains (get-string-all port)
+                                     "(λ (α) (+ α 1))"))))))))))
+
 (test-assert "build-expression->derivation and derivation-prerequisites"
   (let ((drv (build-expression->derivation %store "fail" #f)))
     (any (match-lambda
-          (($ <derivation-input> path)
+          (($ <derivation-input> (= derivation-file-name path))
            (string=? path (derivation-file-name (%guile-for-build)))))
          (derivation-prerequisites drv))))
 
     (match (derivation-prerequisites c
                                      (cut valid-derivation-input? %store
                                           <>))
-      ((($ <derivation-input> file ("out")))
+      ((($ <derivation-input> (= derivation-file-name file) ("out")))
        (string=? file (derivation-file-name b)))
       (x
        (pk 'fail x #f)))))
          (builder    '(begin (sleep 100) (mkdir %output) #t))
          (drv        (build-expression->derivation store "silent" builder))
          (out-path   (derivation->output-path drv)))
-    (guard (c ((nix-protocol-error? c)
-               (and (string-contains (nix-protocol-error-message c)
+    (guard (c ((store-protocol-error? c)
+               (and (string-contains (store-protocol-error-message c)
                                      "failed")
                     (not (valid-path? store out-path)))))
       (build-derivations store (list drv))
          (builder    '(begin (sleep 100) (mkdir %output) #t))
          (drv        (build-expression->derivation store "slow" builder))
          (out-path   (derivation->output-path drv)))
-    (guard (c ((nix-protocol-error? c)
-               (and (string-contains (nix-protocol-error-message c)
+    (guard (c ((store-protocol-error? c)
+               (and (string-contains (store-protocol-error-message c)
                                      "failed")
                     (not (valid-path? store out-path)))))
       (build-derivations store (list drv))
       #f)))
 
-(test-assert "build-expression->derivation and derivation-prerequisites-to-build"
+(test-assert "build-derivations with specific output"
+  (with-store store
+    (let* ((content (random-text))                ;contents of the output
+           (drv     (build-expression->derivation
+                     store "substitute-me"
+                     `(begin ,content (exit 1))   ;would fail
+                     #:outputs '("out" "one" "two")
+                     #:guile-for-build
+                     (package-derivation store %bootstrap-guile)))
+           (out     (derivation->output-path drv)))
+      (with-derivation-substitute drv content
+        (set-build-options store #:use-substitutes? #t
+                           #:substitute-urls (%test-substitute-urls))
+        (and (has-substitutes? store out)
+
+             ;; Ask for nothing but the "out" output of DRV.
+             (build-derivations store `((,drv . "out")))
+
+             ;; Synonymous:
+             (build-derivations store (list (derivation-input drv '("out"))))
+
+             (valid-path? store out)
+             (equal? (pk 'x content)
+                     (pk 'y (call-with-input-file out get-string-all))))))))
+
+(test-assert "build-expression->derivation and derivation-build-plan"
   (let ((drv (build-expression->derivation %store "fail" #f)))
     ;; The only direct dependency is (%guile-for-build) and it's already
     ;; built.
-    (null? (derivation-prerequisites-to-build %store drv))))
+    (null? (derivation-build-plan %store (derivation-inputs drv)))))
 
-(test-assert "derivation-prerequisites-to-build when outputs already present"
-  (let* ((builder    '(begin (mkdir %output) #t))
+(test-assert "derivation-build-plan when outputs already present"
+  (let* ((builder    `(begin ,(random-text) (mkdir %output) #t))
          (input-drv  (build-expression->derivation %store "input" builder))
-         (input-path (derivation-output-path
-                      (assoc-ref (derivation-outputs input-drv)
-                                 "out")))
+         (input-path (derivation->output-path input-drv))
          (drv        (build-expression->derivation %store "something" builder
                                                    #:inputs
                                                    `(("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)))
-    (when (valid-path? %store output)
-      (delete-paths %store (list output)))
-
-    (and (equal? (map derivation-input-path
-                      (derivation-prerequisites-to-build %store drv))
-                 (list (derivation-file-name input-drv)))
+    ;; Assume these things are not already built.
+    (when (or (valid-path? %store input-path)
+              (valid-path? %store output))
+      (error "things already built" input-drv))
+
+    (and (lset= equal?
+                (map derivation-file-name
+                     (derivation-build-plan %store
+                                            (list (derivation-input drv))))
+                (list (derivation-file-name input-drv)
+                      (derivation-file-name drv)))
 
          ;; Build DRV and delete its input.
          (build-derivations %store (list drv))
 
          ;; Now INPUT-PATH is missing, yet it shouldn't be listed as a
          ;; prerequisite to build because DRV itself is already built.
-         (null? (derivation-prerequisites-to-build %store drv)))))
+         (null? (derivation-build-plan %store
+                                       (list (derivation-input drv)))))))
 
-(test-assert "derivation-prerequisites-to-build and substitutes"
+(test-assert "derivation-build-plan and substitutes"
   (let* ((store  (open-connection))
          (drv    (build-expression->derivation store "prereq-subst"
                                                (random 1000)))
 
     (with-derivation-narinfo drv
       (let-values (((build download)
-                    (derivation-prerequisites-to-build store drv))
+                    (derivation-build-plan store
+                                           (list (derivation-input drv))))
                    ((build* download*)
-                    (derivation-prerequisites-to-build store drv
-                                                       #:substitutable?
-                                                       (const #f))))
+                    (derivation-build-plan store
+                                           (list (derivation-input drv))
+                                           #:substitutable-info
+                                           (const #f))))
         (and (null? build)
-             (equal? download (list output))
+             (equal? (map substitutable-path download) (list output))
              (null? download*)
-             (null? build*))))))
+             (equal? (list drv) build*))))))
 
-(test-assert "derivation-prerequisites-to-build and substitutes, non-substitutable build"
+(test-assert "derivation-build-plan and substitutes, non-substitutable build"
   (let* ((store  (open-connection))
          (drv    (build-expression->derivation store "prereq-no-subst"
                                                (random 1000)
 
     (with-derivation-narinfo drv
       (let-values (((build download)
-                    (derivation-prerequisites-to-build store drv)))
+                    (derivation-build-plan store
+                                           (list (derivation-input drv)))))
         ;; Despite being available as a substitute, DRV will be built locally
         ;; due to #:substitutable? #f.
         (and (null? download)
              (match build
-               (((? derivation-input? input))
-                (string=? (derivation-input-path input)
-                          (derivation-file-name drv)))))))))
+               (((= derivation-file-name build))
+                (string=? build (derivation-file-name drv)))))))))
+
+(test-assert "derivation-build-plan and substitutes, non-substitutable dep"
+  (with-store store
+    (let* ((drv1 (build-expression->derivation store "prereq-no-subst"
+                                               (random 1000)
+                                               #:substitutable? #f))
+           (drv2 (build-expression->derivation store "substitutable"
+                                               (random 1000)
+                                               #:inputs `(("dep" ,drv1)))))
+
+      ;; Make sure substitutes are usable.
+      (set-build-options store #:use-substitutes? #t
+                         #:substitute-urls (%test-substitute-urls))
 
-(test-assert "derivation-prerequisites-to-build and substitutes, local build"
+      (with-derivation-narinfo drv2
+        (sha256 => (make-bytevector 32 0))
+        (references => (list (derivation->output-path drv1)))
+
+        (let-values (((build download)
+                      (derivation-build-plan store
+                                             (list (derivation-input drv2)))))
+          ;; Although DRV2 is available as a substitute, we must build its
+          ;; dependency, DRV1, due to #:substitutable? #f.
+          (and (match download
+                 (((= substitutable-path item))
+                  (string=? item (derivation->output-path drv2))))
+               (match build
+                 (((= derivation-file-name build))
+                  (string=? build (derivation-file-name drv1))))))))))
+
+(test-assert "derivation-build-plan and substitutes, local build"
   (with-store store
     (let* ((drv    (build-expression->derivation store "prereq-subst-local"
                                                  (random 1000)
 
       (with-derivation-narinfo drv
         (let-values (((build download)
-                      (derivation-prerequisites-to-build store drv)))
+                      (derivation-build-plan store
+                                             (list (derivation-input drv)))))
           ;; #:local-build? is *not* synonymous with #:substitutable?, so we
           ;; must be able to substitute DRV's output.
           ;; See <http://bugs.gnu.org/18747>.
           (and (null? build)
                (match download
-                 (((? string? item))
+                 (((= substitutable-path item))
                   (string=? item (derivation->output-path drv))))))))))
 
-(test-assert "derivation-prerequisites-to-build in 'check' mode"
+(test-assert "derivation-build-plan in 'check' mode"
   (with-store store
     (let* ((dep (build-expression->derivation store "dep"
                                               `(begin ,(random-text)
       (delete-paths store (list (derivation->output-path dep)))
 
       ;; In 'check' mode, DEP must be rebuilt.
-      (and (null? (derivation-prerequisites-to-build store drv))
-           (match (derivation-prerequisites-to-build store drv
-                                                     #:mode (build-mode
-                                                             check))
-             ((input)
-              (string=? (derivation-input-path input)
-                        (derivation-file-name dep))))))))
+      (and (null? (derivation-build-plan store
+                                         (list (derivation-input drv))))
+           (lset= equal?
+                  (derivation-build-plan store
+                                         (list (derivation-input drv))
+                                         #:mode (build-mode check))
+                  (list drv dep))))))
+
+(test-assert "derivation-input-fold"
+  (let* ((builder (add-text-to-store %store "my-builder.sh"
+                                     "echo hello, world > \"$out\"\n"
+                                     '()))
+         (drv1    (derivation %store "foo"
+                              %bash `(,builder)
+                              #:sources `(,%bash ,builder)))
+         (drv2    (derivation %store "bar"
+                              %bash `(,builder)
+                              #:inputs `((,drv1))
+                              #:sources `(,%bash ,builder))))
+    (equal? (derivation-input-fold (lambda (input result)
+                                     (cons (derivation-input-derivation input)
+                                           result))
+                                   '()
+                                   (list (derivation-input drv2)))
+            (list drv1 drv2))))
+
+(test-assert "substitution-oracle and #:substitute? #f"
+  (with-store store
+    (let* ((dep   (build-expression->derivation store "dep"
+                                                `(begin ,(random-text)
+                                                        (mkdir %output))))
+           (drv   (build-expression->derivation store "not-subst"
+                                                `(begin ,(random-text)
+                                                        (mkdir %output))
+                                                #:substitutable? #f
+                                                #:inputs `(("dep" ,dep))))
+           (query #f))
+      (define (record-substitutable-path-query store paths)
+        (when query
+          (error "already called!" query))
+        (set! query paths)
+        '())
+
+      (mock ((guix store) substitutable-path-info
+             record-substitutable-path-query)
+
+            (let ((pred (substitution-oracle store (list drv))))
+              (pred (derivation->output-path drv))))
+
+      ;; Make sure the oracle didn't try to get substitute info for DRV since
+      ;; DRV is mark as non-substitutable.  Assume that GUILE-FOR-BUILD is
+      ;; already in store and thus not part of QUERY.
+      (equal? (pk 'query query)
+              (list (derivation->output-path dep))))))
 
 (test-assert "build-expression->derivation with expression returning #f"
   (let* ((builder  '(begin
                       #f))                        ; fail!
          (drv      (build-expression->derivation %store "fail" builder))
          (out-path (derivation->output-path drv)))
-    (guard (c ((nix-protocol-error? c)
+    (guard (c ((store-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))
+                                  (store-protocol-error-message c))
                     (not (valid-path? %store out-path)))))
       (build-derivations %store (list drv))
       #f)))
          (builder2   '(call-with-output-file (pk 'difference-here! %output)
                         (lambda (p)
                           (write "hello" p))))
-         (hash       (sha256 (string->utf8 "hello")))
+         (hash       (gcrypt:sha256 (string->utf8 "hello")))
          (input1     (build-expression->derivation %store "fixed" builder1
                                                    #:hash hash
                                                    #:hash-algo 'sha256))
          (builder2   '(call-with-output-file (pk 'difference-here! %output)
                         (lambda (p)
                           (write "hello" p))))
-         (hash       (sha256 (string->utf8 "hello")))
+         (hash       (gcrypt:sha256 (string->utf8 "hello")))
          (input1     (build-expression->derivation %store "fixed" builder1
                                                    #:hash hash
                                                    #:hash-algo 'sha256))
                                     ((p2 . _)
                                      (string<? p1 p2)))))))))))))
 
+(test-equal "derivation-properties"
+  (list '() '((type . test)))
+  (let ((drv1 (build-expression->derivation %store "bar"
+                                            '(mkdir %output)))
+        (drv2 (build-expression->derivation %store "foo"
+                                           '(mkdir %output)
+                                           #:properties '((type . test)))))
+    (list (derivation-properties drv1)
+          (derivation-properties drv2))))
+
 (test-equal "map-derivation"
   "hello"
   (let* ((joke (package-derivation %store guile-1.8))
                                 (derivation->output-path bash-full)
 
                                 `("-e" ,script1)
-                                #:inputs `((,bash-full) (,script1))))
+                                #:sources (list script1)
+                                #:inputs
+                                (list (derivation-input bash-full '("out")))))
          (drv2      (map-derivation %store drv1
                                     `((,bash-full . ,%bash)
                                       (,script1 . ,script2))))
          (call-with-input-file out get-string-all))))
 
 (test-end)
+
+;; Local Variables:
+;; eval: (put 'with-http-server 'scheme-indent-function 1)
+;; End: