me
/
guix
Archived
1
0
Fork 0
Code

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.
master
Ludovic Courtès 2015-01-09 23:33:42 +01:00
parent eb9dfcb3c4
commit 0b6af195fe
2 changed files with 18 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
guix/derivations.scm
View File

@ -58,6 +58,7 @@
derivation-input-output-paths derivation-input-output-paths
derivation-name derivation-name
derivation-output-names
fixed-output-derivation? fixed-output-derivation?
offloadable-derivation? offloadable-derivation?
substitutable-derivation? substitutable-derivation?
@ -135,6 +136,12 @@
(let ((base (store-path-package-name (derivation-file-name drv)))) (let ((base (store-path-package-name (derivation-file-name drv))))
(string-drop-right base 4))) (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) (define (fixed-output-derivation? drv)
"Return #t if DRV is a fixed-output derivation, such as the result of a "Return #t if DRV is a fixed-output derivation, such as the result of a
download with a fixed hash (aka. `fetchurl')." 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 (define* (derivation-prerequisites-to-build store drv
#:key #:key
(outputs (outputs
(map (derivation-output-names drv))
car
(derivation-outputs drv)))
(use-substitutes? #t)) (use-substitutes? #t))
"Return two values: the list of derivation-inputs required to build the "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 OUTPUTS of DRV and not already available in STORE, recursively, and the list
@ -844,7 +849,7 @@ recursively."
replacements)))) replacements))))
(derivation-builder-environment-vars drv)) (derivation-builder-environment-vars drv))
#:inputs (append (map list sources) inputs) #:inputs (append (map list sources) inputs)
#:outputs (map car (derivation-outputs drv)) #:outputs (derivation-output-names drv)
#:hash (match (derivation-outputs drv) #:hash (match (derivation-outputs drv)
((($ <derivation-output> _ algo hash)) ((($ <derivation-output> _ algo hash))
hash) hash)

10
tests/derivations.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -178,6 +178,14 @@
(let ((drv (derivation %store "foo-0.0" %bash '()))) (let ((drv (derivation %store "foo-0.0" %bash '())))
(derivation-name drv))) (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?" (test-assert "offloadable-derivation?"
(and (offloadable-derivation? (derivation %store "foo" %bash '())) (and (offloadable-derivation? (derivation %store "foo" %bash '()))
(not (offloadable-derivation? (not (offloadable-derivation?