derivations: Add 'derivation-input'.

* guix/derivations.scm (derivation-input): New procedure.
* tests/grafts.scm (make-derivation-input): Remove.
("graft-derivation, unused outputs not depended on"): Use
'derivation-input'.
This commit is contained in:
Ludovic Courtès 2019-06-23 11:46:17 +02:00
parent 4311cf965c
commit c89985d91d
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 12 additions and 12 deletions

View File

@ -157,6 +157,14 @@
"Return the <derivation> object INPUT refers to." "Return the <derivation> object INPUT refers to."
(read-derivation-from-file (derivation-input-path input))) (read-derivation-from-file (derivation-input-path input)))
(define* (derivation-input drv #:optional
(outputs (derivation-output-names drv)))
"Return a <derivation-input> for the OUTPUTS of DRV."
;; This is a public interface meant to be more convenient than
;; 'make-derivation-input' and giving us more control.
(make-derivation-input (derivation-file-name drv)
outputs))
(set-record-type-printer! <derivation> (set-record-type-printer! <derivation>
(lambda (drv port) (lambda (drv port)
(format port "#<derivation ~a => ~a ~a>" (format port "#<derivation ~a => ~a ~a>"

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -45,9 +45,6 @@
(define %mkdir (define %mkdir
(bootstrap-binary "mkdir")) (bootstrap-binary "mkdir"))
(define make-derivation-input
(@@ (guix derivations) make-derivation-input))
(test-begin "grafts") (test-begin "grafts")
@ -356,16 +353,11 @@
(p1r-inputs (filter (match-input p1r) inputs)) (p1r-inputs (filter (match-input p1r) inputs))
(p2-inputs (filter (match-input p2) inputs))) (p2-inputs (filter (match-input p2) inputs)))
(and (equal? p1-inputs (and (equal? p1-inputs
(list (make-derivation-input (derivation-file-name p1) (list (derivation-input p1 '("one"))))
'("one"))))
(equal? p1r-inputs (equal? p1r-inputs
(list (list (derivation-input p1r '("ONE"))))
(make-derivation-input (derivation-file-name p1r)
'("ONE"))))
(equal? p2-inputs (equal? p2-inputs
(list (list (derivation-input p2 '("aaa"))))
(make-derivation-input (derivation-file-name p2)
'("aaa"))))
(derivation-output-names p2g)))))) (derivation-output-names p2g))))))
(test-assert "graft-derivation, renaming" ;<http://bugs.gnu.org/23132> (test-assert "graft-derivation, renaming" ;<http://bugs.gnu.org/23132>