summary refs log tree commit diff
path: root/tests/derivations.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-09-18 17:01:40 +0200
committerLudovic Courtès <ludo@gnu.org>2013-09-18 18:49:53 +0200
commit59688fc4b5cfac3e05610195a47795f5cc15f338 (patch)
treea1f498fc498857e65e5002817760c8721c9caf45 /tests/derivations.scm
parent81b66f8567ea2e3ecb0983318d5dedd3b1332e48 (diff)
downloadguix-59688fc4b5cfac3e05610195a47795f5cc15f338.tar.gz
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.
Diffstat (limited to 'tests/derivations.scm')
-rw-r--r--tests/derivations.scm219
1 files changed, 102 insertions, 117 deletions
diff --git a/tests/derivations.scm b/tests/derivations.scm
index e69dd0db31..4756fb9cba 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -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"