From 59688fc4b5cfac3e05610195a47795f5cc15f338 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Wed, 18 Sep 2013 17:01:40 +0200
Subject: 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.
---
 tests/packages.scm | 38 +++++++++++++++++---------------------
 1 file changed, 17 insertions(+), 21 deletions(-)

(limited to 'tests/packages.scm')

diff --git a/tests/packages.scm b/tests/packages.scm
index 8619011f59..706739fb70 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -121,17 +121,16 @@ (define read-at
                                              (package-source package))))
     (string=? file source)))
 
-(test-assert "return values"
-  (let-values (((drv-path drv)
-                (package-derivation %store (dummy-package "p"))))
-    (and (derivation-path? drv-path)
-         (derivation? drv))))
+(test-assert "return value"
+  (let ((drv (package-derivation %store (dummy-package "p"))))
+    (and (derivation? drv)
+         (file-exists? (derivation-file-name drv)))))
 
 (test-assert "package-output"
   (let* ((package  (dummy-package "p"))
-         (drv-path (package-derivation %store package)))
-    (and (derivation-path? drv-path)
-         (string=? (derivation-path->output-path drv-path)
+         (drv      (package-derivation %store package)))
+    (and (derivation? drv)
+         (string=? (derivation->output-path drv)
                    (package-output %store package "out")))))
 
 (test-assert "trivial"
@@ -148,7 +147,7 @@ (define read-at
                        (display '(hello guix) p))))))))
          (d (package-derivation %store p)))
     (and (build-derivations %store (list d))
-         (let ((p (pk 'drv d (derivation-path->output-path d))))
+         (let ((p (pk 'drv d (derivation->output-path d))))
            (equal? '(hello guix)
                    (call-with-input-file (string-append p "/test") read))))))
 
@@ -164,7 +163,7 @@ (define read-at
               (inputs `(("input" ,i)))))
          (d (package-derivation %store p)))
     (and (build-derivations %store (list d))
-         (let ((p (pk 'drv d (derivation-path->output-path d))))
+         (let ((p (pk 'drv d (derivation->output-path d))))
            (equal? (call-with-input-file p get-bytevector-all)
                    (call-with-input-file i get-bytevector-all))))))
 
@@ -183,7 +182,7 @@ (define read-at
                                                           (%current-system)))))))
          (d (package-derivation %store p)))
     (and (build-derivations %store (list d))
-         (let ((p (pk 'drv d (derivation-path->output-path d))))
+         (let ((p (pk 'drv d (derivation->output-path d))))
            (eq? 'hello (call-with-input-file p read))))))
 
 (test-assert "search paths"
@@ -222,20 +221,17 @@ (define read-at
            (equal? x (collect (package-derivation %store c)))))))
 
 (test-assert "package-cross-derivation"
-  (let-values (((drv-path drv)
-                (package-cross-derivation %store (dummy-package "p")
-                                          "mips64el-linux-gnu")))
-    (and (derivation-path? drv-path)
-         (derivation? drv))))
+  (let ((drv (package-cross-derivation %store (dummy-package "p")
+                                       "mips64el-linux-gnu")))
+    (and (derivation? drv)
+         (file-exists? (derivation-file-name drv)))))
 
 (test-assert "package-cross-derivation, trivial-build-system"
   (let ((p (package (inherit (dummy-package "p"))
              (build-system trivial-build-system)
              (arguments '(#:builder (exit 1))))))
-    (let-values (((drv-path drv)
-                  (package-cross-derivation %store p "mips64el-linux-gnu")))
-      (and (derivation-path? drv-path)
-           (derivation? drv)))))
+    (let ((drv (package-cross-derivation %store p "mips64el-linux-gnu")))
+      (derivation? drv))))
 
 (test-assert "package-cross-derivation, no cross builder"
   (let* ((b (build-system (inherit trivial-build-system)
@@ -257,7 +253,7 @@ (define read-at
          (or (location? (package-location gnu-make))
              (not (package-location gnu-make)))
          (let* ((drv (package-derivation %store gnu-make))
-                (out (derivation-path->output-path drv)))
+                (out (derivation->output-path drv)))
            (and (build-derivations %store (list drv))
                 (file-exists? (string-append out "/bin/make")))))))
 
-- 
cgit v1.2.3