02/03: derivations: Add 'derivation-output-names'.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 0b6af195fe7476a15e498b24c67f9d8f6080a400
Author: Ludovic Courtès <address@hidden>
Date:   Fri Jan 9 23:33:42 2015 +0100

    derivations: Add 'derivation-output-names'.
    
    * guix/derivations.scm (derivation-output-names): New procedure.
      (derivation-prerequisites-to-build): Use it for #:outputs.
      (map-derivation): Likewise.
    * tests/derivations.scm ("derivation-output-names"): New test.
---
 guix/derivations.scm  |   13 +++++++++----
 tests/derivations.scm |   10 +++++++++-
 2 files changed, 18 insertions(+), 5 deletions(-)

diff --git a/guix/derivations.scm b/guix/derivations.scm
index 69cef1a..5e96d9f 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -58,6 +58,7 @@
             derivation-input-output-paths
 
             derivation-name
+            derivation-output-names
             fixed-output-derivation?
             offloadable-derivation?
             substitutable-derivation?
@@ -135,6 +136,12 @@
   (let ((base (store-path-package-name (derivation-file-name drv))))
     (string-drop-right base 4)))
 
+(define (derivation-output-names drv)
+  "Return the names of the outputs of DRV."
+  (match (derivation-outputs drv)
+    (((names . _) ...)
+     names)))
+
 (define (fixed-output-derivation? drv)
   "Return #t if DRV is a fixed-output derivation, such as the result of a
 download with a fixed hash (aka. `fetchurl')."
@@ -180,9 +187,7 @@ download with a fixed hash (aka. `fetchurl')."
 (define* (derivation-prerequisites-to-build store drv
                                             #:key
                                             (outputs
-                                             (map
-                                              car
-                                              (derivation-outputs drv)))
+                                             (derivation-output-names drv))
                                             (use-substitutes? #t))
   "Return two values: the list of derivation-inputs required to build the
 OUTPUTS of DRV and not already available in STORE, recursively, and the list
@@ -844,7 +849,7 @@ recursively."
                                                        replacements))))
                                     (derivation-builder-environment-vars drv))
                     #:inputs (append (map list sources) inputs)
-                    #:outputs (map car (derivation-outputs drv))
+                    #:outputs (derivation-output-names drv)
                     #:hash (match (derivation-outputs drv)
                              ((($ <derivation-output> _ algo hash))
                               hash)
diff --git a/tests/derivations.scm b/tests/derivations.scm
index 4b36758..25e6f75 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <address@hidden>
+;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -178,6 +178,14 @@
   (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 '()))
        (not (offloadable-derivation?