ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 21:38:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

grafts: Apply the right grafts in the presence of multiple outputs.

Browse source 
Fixes <http://bugs.gnu.org/24712>.

* guix/grafts.scm (cumulative-grafts): Add grafts for all the outputs of
DRV.
* tests/grafts.scm ("graft-derivation, replaced derivation has multiple
outputs"): New test.
This commit is contained in:
Ludovic Courtès 2016-10-17 23:43:33 +02:00
parent 645b9df858
commit 3d47aa81ba
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 61 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
guix/grafts.scm
View file

@ -280,7 +280,18 @@ (define (return/cache cache value)
(let* ((new (graft-derivation/shallow store drv applicable
#:guile guile
#:system system))
(grafts (cons (graft (origin drv) (replacement new))
;; Replace references to any of the outputs of DRV,
;; even if that's more than needed. This is so that
;; the result refers only to the outputs of NEW and
;; not to those of DRV.
(grafts (append (map (lambda (output)
(graft
(origin drv)
(origin-output output)
(replacement new)
(replacement-output output)))
(derivation-output-names drv))
grafts)))
(return/cache cache grafts))))))))))))

48
tests/grafts.scm
View file

@ -201,6 +201,54 @@ (define %mkdir
(and (string=? (readlink one) repl)
(string=? (readlink two) one))))))
(test-assert "graft-derivation, replaced derivation has multiple outputs"
;; Here we have a replacement just for output "one" of P1 and not for the
;; other output. Make sure the graft for P1:one correctly applies to the
;; dependents of P1. See <http://bugs.gnu.org/24712>.
(let* ((p1 (build-expression->derivation
%store "p1"
`(let ((one (assoc-ref %outputs "one"))
(two (assoc-ref %outputs "two")))
(mkdir one)
(mkdir two))
#:outputs '("one" "two")))
(p1r (build-expression->derivation
%store "P1"
`(let ((other (assoc-ref %outputs "ONE")))
(mkdir other)
(call-with-output-file (string-append other "/replacement")
(const #t)))
#:outputs '("ONE")))
(p2 (build-expression->derivation
%store "p2"
`(let ((out (assoc-ref %outputs "aaa")))
(mkdir (assoc-ref %outputs "zzz"))
(mkdir out) (chdir out)
(symlink (assoc-ref %build-inputs "p1:one") "one")
(symlink (assoc-ref %build-inputs "p1:two") "two"))
#:outputs '("aaa" "zzz")
#:inputs `(("p1:one" ,p1 "one")
("p1:two" ,p1 "two"))))
(p3 (build-expression->derivation
%store "p3"
`(symlink (assoc-ref %build-inputs "p2:aaa")
(assoc-ref %outputs "out"))
#:inputs `(("p2:aaa" ,p2 "aaa")
("p2:zzz" ,p2 "zzz"))))
(p1g (graft
(origin p1)
(origin-output "one")
(replacement p1r)
(replacement-output "ONE")))
(p3d (graft-derivation %store p3 (list p1g))))
(and (build-derivations %store (list p3d))
(let ((out (derivation->output-path (pk 'p2d p3d))))
(and (not (string=? (readlink out)
(derivation->output-path p2 "aaa")))
(string=? (derivation->output-path p1 "two")
(readlink (string-append out "/two")))
(file-exists? (string-append out "/one/replacement")))))))
(test-assert "graft-derivation, renaming" ;<http://bugs.gnu.org/23132>
(let* ((build `(begin
(use-modules (guix build utils))