packages: Remove 'search-bootstrap-binary'.
[jackhill/guix/guix.git] / tests / derivations.scm
index 8760910..25ba4c9 100644 (file)
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 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)
   #: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)
   #:use-module (ice-9 match))
 
 (define %store
-  (false-if-exception (open-connection)))
+  (open-connection-for-tests))
 
-(when %store
-  ;; Make sure we build everything by ourselves.
-  (set-build-options %store #:use-substitutes? #f)
-
-  ;; By default, use %BOOTSTRAP-GUILE for the current system.
-  (let ((drv (package-derivation %store %bootstrap-guile)))
-    (%guile-for-build drv)))
+;; Globally disable grafts because they can trigger early builds.
+(%graft? #f)
 
 (define (bootstrap-binary name)
   (let ((bin (search-bootstrap-binary name (%current-system))))
         (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"
 (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)
          ;; 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))))
+           (d2 (build-expression->derivation %store "sleep-then-succeed"
+                                             `(begin
+                                                ,(random-text)
+                                                ;; XXX: Hopefully that's long
+                                                ;; enough that D1 has already
+                                                ;; failed.
+                                                (sleep 2)
+                                                (mkdir %output)))))
+      (set-build-options %store
+                         #:use-substitutes? #f
+                         #:keep-going? #t)
+      (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)))))
+        (build-derivations %store (list d1 d2))
+        #f))))
+
+(test-assert "identical files are deduplicated"
+  (let* ((build1  (add-text-to-store %store "one.sh"
+                                     "echo hello, world > \"$out\"\n"
+                                     '()))
+         (build2  (add-text-to-store %store "two.sh"
+                                     "# Hey!\necho hello, world > \"$out\"\n"
+                                     '()))
+         (drv1    (derivation %store "foo"
+                              %bash `(,build1)
+                              #:inputs `((,%bash) (,build1))))
+         (drv2    (derivation %store "bar"
+                              %bash `(,build2)
+                              #:inputs `((,%bash) (,build2)))))
+    (and (build-derivations %store (list drv1 drv2))
+         (let ((file1 (derivation->output-path drv1))
+               (file2 (derivation->output-path drv2)))
+           (and (valid-path? %store file1) (valid-path? %store file2)
+                (string=? (call-with-input-file file1 get-string-all)
+                          "hello, world\n")
+                (= (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 (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 (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 (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 (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 '())))
+    (derivation-name drv)))
+
+(test-equal "derivation-output-names"
+  '(("out") ("bar" "chbouib"))
+  (let ((drv1 (derivation %store "foo-0.0" %bash '()))
+        (drv2 (derivation %store "foo-0.0" %bash '()
+                          #:outputs '("bar" "chbouib"))))
+    (list (derivation-output-names drv1)
+          (derivation-output-names drv2))))
+
+(test-assert "offloadable-derivation?"
+  (and (offloadable-derivation? (derivation %store "foo" %bash '()))
+       (offloadable-derivation?               ;see <http://bugs.gnu.org/18747>
+        (derivation %store "foo" %bash '()
+                    #:substitutable? #f))
+       (not (offloadable-derivation?
+             (derivation %store "foo" %bash '()
+                         #:local-build? #t)))))
+
+(test-assert "substitutable-derivation?"
+  (and (substitutable-derivation? (derivation %store "foo" %bash '()))
+       (substitutable-derivation?             ;see <http://bugs.gnu.org/18747>
+        (derivation %store "foo" %bash '()
+                    #:local-build? #t))
+       (not (substitutable-derivation?
+             (derivation %store "foo" %bash '()
+                         #:substitutable? #f)))))
+
 (test-assert "fixed-output-derivation?"
   (let* ((builder    (add-text-to-store %store "my-fixed-builder.sh"
                                         "echo -n hello > $out" '()))
            (and (eq? 'one (call-with-input-file one read))
                 (eq? 'two (call-with-input-file two read)))))))
 
+(test-assert "read-derivation vs. derivation"
+  ;; Make sure 'derivation' and 'read-derivation' return objects that are
+  ;; identical.
+  (let* ((sources (unfold (cut >= <> 10)
+                          (lambda (n)
+                            (add-text-to-store %store
+                                               (format #f "input~a" n)
+                                               (random-text)))
+                          1+
+                          0))
+         (inputs  (map (lambda (file)
+                         (derivation %store "derivation-input"
+                                     %bash '()
+                                     #:inputs `((,%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)))
+                              #:outputs '("two" "one")))
+         (drv*    (call-with-input-file (derivation-file-name drv)
+                    read-derivation)))
+    (equal? drv* drv)))
+
 (test-assert "multiple-output derivation, derivation-path->output-path"
   (let* ((builder    (add-text-to-store %store "builder.sh"
                                         "echo one > $out ; echo two > $second"
                           `("-c" ,(string-append "echo " txt "> $out"))
                           #:inputs `((,%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))
                          `("-c" ,"echo $out > $out")
                          #:inputs `((,%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))
       #f)))
 
+(test-assert "derivation #:disallowed-references, ok"
+  (let ((drv (derivation %store "disallowed" %bash
+                         '("-c" "echo hello > $out")
+                         #:inputs `((,%bash))
+                         #:disallowed-references '("out"))))
+    (build-derivations %store (list drv))))
+
+(test-assert "derivation #:disallowed-references, not ok"
+  (let* ((txt (add-text-to-store %store "foo" "Hello, world."))
+         (drv (derivation %store "disdisallowed" %bash
+                          `("-c" ,(string-append "echo " txt "> $out"))
+                          #:inputs `((,%bash) (,txt))
+                          #:disallowed-references (list txt))))
+    (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 $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 "GUIX_STATE_DIRECTORY")
+  (let* ((value (getenv "GUIX_STATE_DIRECTORY"))
+         (drv   (derivation %store "leaked-env-vars" %bash
+                            '("-c" "echo -n $GUIX_STATE_DIRECTORY > $out")
+                            #:hash (sha256 (string->utf8 value))
+                            #:hash-algo 'sha256
+                            #:inputs `((,%bash))
+                            #:leaked-env-vars '("GUIX_STATE_DIRECTORY"))))
+    (and (build-derivations %store (list drv))
+         (call-with-input-file (derivation->output-path drv)
+           get-string-all))))
+
 \f
 (define %coreutils
   (false-if-exception
-   (and (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)
-        (or (package-derivation %store %bootstrap-coreutils&co)
-            (nixpkgs-derivation "coreutils")))))
+   (and (network-reachable?)
+        (package-derivation %store %bootstrap-coreutils&co))))
 
 (test-skip (if %coreutils 0 1))
 
 
 (test-skip (if (%guile-for-build) 0 8))
 
+(test-equal "build-expression->derivation and invalid module name"
+  '(file-search-error "guix/module/that/does/not/exist.scm")
+  (guard (c ((file-search-error? c)
+             (list 'file-search-error
+                   (file-search-error-file-name c))))
+    (build-expression->derivation %store "foo" #t
+                                  #: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
            (string=? path (derivation-file-name (%guile-for-build)))))
          (derivation-prerequisites drv))))
 
+(test-assert "derivation-prerequisites and valid-derivation-input?"
+  (let* ((a (build-expression->derivation %store "a" '(mkdir %output)))
+         (b (build-expression->derivation %store "b" `(list ,(random-text))))
+         (c (build-expression->derivation %store "c" `(mkdir %output)
+                                          #:inputs `(("a" ,a) ("b" ,b)))))
+    ;; Make sure both A and %BOOTSTRAP-GUILE are built (the latter could have
+    ;; be removed by tests/guix-gc.sh.)
+    (build-derivations %store
+                       (list a (package-derivation %store %bootstrap-guile)))
+
+    (match (derivation-prerequisites c
+                                     (cut valid-derivation-input? %store
+                                          <>))
+      ((($ <derivation-input> file ("out")))
+       (string=? file (derivation-file-name b)))
+      (x
+       (pk 'fail x #f)))))
+
 (test-assert "build-expression->derivation without inputs"
   (let* ((builder    '(begin
                         (mkdir %output)
          (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-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")))
+
+             (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-prerequisites-to-build"
   (let ((drv (build-expression->derivation %store "fail" #f)))
     ;; The only direct dependency is (%guile-for-build) and it's already
          ;; prerequisite to build because DRV itself is already built.
          (null? (derivation-prerequisites-to-build %store drv)))))
 
-(test-skip (if (getenv "GUIX_BINARY_SUBSTITUTE_URL") 0 1))
 (test-assert "derivation-prerequisites-to-build and substitutes"
   (let* ((store  (open-connection))
          (drv    (build-expression->derivation store "prereq-subst"
                                                (random 1000)))
-         (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")
-      (lambda (p)
-        (format p "StoreDir: ~a\nWantMassQuery: 0\n"
-                (%store-prefix))))
-    (call-with-output-file (string-append dir "/" (store-path-hash-part output)
-                                          ".narinfo")
-      (lambda (p)
-        (format p "StorePath: ~a
-URL: ~a
-Compression: none
-NarSize: 1234
-References: 
-System: ~a
-Deriver: ~a~%"
-                output                              ; StorePath
-                (string-append dir "/example.nar")  ; URL
-                (%current-system)                   ; System
-                (basename
-                 (derivation-file-name drv)))))     ; Deriver
+         (output (derivation->output-path drv)))
+
+    ;; Make sure substitutes are usable.
+    (set-build-options store #:use-substitutes? #t
+                       #:substitute-urls (%test-substitute-urls))
+
+    (with-derivation-narinfo drv
+      (let-values (((build download)
+                    (derivation-prerequisites-to-build store drv))
+                   ((build* download*)
+                    (derivation-prerequisites-to-build store drv
+                                                       #:substitutable-info
+                                                       (const #f))))
+        (and (null? build)
+             (equal? (map substitutable-path download) (list output))
+             (null? download*)
+             (null? build*))))))
+
+(test-assert "derivation-prerequisites-to-build and substitutes, non-substitutable build"
+  (let* ((store  (open-connection))
+         (drv    (build-expression->derivation store "prereq-no-subst"
+                                               (random 1000)
+                                               #:substitutable? #f))
+         (output (derivation->output-path drv)))
 
     ;; Make sure substitutes are usable.
-    (set-build-options store #:use-substitutes? #t)
-
-    (let-values (((build download)
-                  (derivation-prerequisites-to-build store drv))
-                 ((build* download*)
-                  (derivation-prerequisites-to-build store drv
-                                                     #:use-substitutes? #f)))
-      (pk build download build* download*)
-      (and (null? build)
-           (equal? download (list output))
-           (null? download*)
-           (null? build*)))))
+    (set-build-options store #:use-substitutes? #t
+                       #:substitute-urls (%test-substitute-urls))
+
+    (with-derivation-narinfo drv
+      (let-values (((build download)
+                    (derivation-prerequisites-to-build store 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)))))))))
+
+(test-assert "derivation-prerequisites-to-build and substitutes, local build"
+  (with-store store
+    (let* ((drv    (build-expression->derivation store "prereq-subst-local"
+                                                 (random 1000)
+                                                 #:local-build? #t))
+           (output (derivation->output-path drv)))
+
+      ;; Make sure substitutes are usable.
+      (set-build-options store #:use-substitutes? #t
+                         #:substitute-urls (%test-substitute-urls))
+
+      (with-derivation-narinfo drv
+        (let-values (((build download)
+                      (derivation-prerequisites-to-build store 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
+                 (((= substitutable-path item))
+                  (string=? item (derivation->output-path drv))))))))))
+
+(test-assert "derivation-prerequisites-to-build in 'check' mode"
+  (with-store store
+    (let* ((dep (build-expression->derivation store "dep"
+                                              `(begin ,(random-text)
+                                                      (mkdir %output))))
+           (drv (build-expression->derivation store "to-check"
+                                              '(mkdir %output)
+                                              #:inputs `(("dep" ,dep)))))
+      (build-derivations store (list drv))
+      (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))))))))
+
+(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
@@ -591,11 +964,11 @@ Deriver: ~a~%"
                       #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)))
@@ -635,23 +1008,6 @@ Deriver: ~a~%"
          (let ((p (derivation->output-path drv)))
            (string-contains (call-with-input-file p read-line) "GNU")))))
 
-(test-assert "imported-files"
-  (let* ((files    `(("x"     . ,(search-path %load-path "ice-9/q.scm"))
-                     ("a/b/c" . ,(search-path %load-path
-                                              "guix/derivations.scm"))
-                     ("p/q"   . ,(search-path %load-path "guix.scm"))
-                     ("p/z"   . ,(search-path %load-path "guix/store.scm"))))
-         (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)
-                              get-bytevector-all)
-                            (call-with-input-file source
-                              get-bytevector-all))))
-                  files)))))
-
 (test-assert "build-expression->derivation with modules"
   (let* ((builder  `(begin
                       (use-modules (guix build utils))
@@ -798,6 +1154,15 @@ Deriver: ~a~%"
                                     ((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"
@@ -846,5 +1211,6 @@ Deriver: ~a~%"
 
 (test-end)
 
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
+;; Local Variables:
+;; eval: (put 'with-http-server 'scheme-indent-function 2)
+;; End: