nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

grafts: Consider all the outputs in the graft mapping. 

Before that, outputs of a derivation could be left referring to the
ungrafted version of the derivation.

* guix/grafts.scm (graft-derivation)[outputs]: Change to a list of
name/file pairs.
* guix/grafts.scm (graft-derivation)[build]: Add 'old-outputs' variable
and use it when computing 'mapping'.  Use 'mapping' directly.
* tests/grafts.scm ("graft-derivation, multiple outputs"): New test.
This commit is contained in:
Ludovic Courtès 2016-02-27 23:28:35 +01:00
parent cd05d38812
commit f376dc3acb
2 changed files with 35 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
guix/grafts.scm
View File

@ -82,9 +82,10 @@ applied."
grafts))
(define outputs
(match (derivation-outputs drv)
(((names . outputs) ...)
(map derivation-output-path outputs))))
(map (match-lambda
((name . output)
(cons name (derivation-output-path output))))
(derivation-outputs drv)))
(define output-names
(derivation-output-names drv))
@ -95,14 +96,20 @@ applied."
(guix build utils)
(ice-9 match))
(let ((mapping ',mapping))
(let* ((old-outputs ',outputs)
(mapping (append ',mapping
(map (match-lambda
((name . file)
(cons (assoc-ref old-outputs name)
file)))
%outputs))))
(for-each (lambda (input output)
(format #t "grafting '~a' -> '~a'...~%" input output)
(force-output)
(rewrite-directory input output
`((,input . ,output)
,@mapping)))
',outputs
(rewrite-directory input output mapping))
(match old-outputs
(((names . files) ...)
files))
(match %outputs
(((names . files) ...)
files))))))

20
tests/grafts.scm
View File

@ -75,6 +75,26 @@
(string=? (readlink (string-append graft "/sh")) one)
(string=? (readlink (string-append graft "/self")) graft))))))
(test-assert "graft-derivation, multiple outputs"
(let* ((build `(begin
(symlink (assoc-ref %build-inputs "a")
(assoc-ref %outputs "one"))
(symlink (assoc-ref %outputs "one")
(assoc-ref %outputs "two"))))
(orig (build-expression->derivation %store "grafted" build
#:inputs `(("a" ,%bash))
#:outputs '("one" "two")))
(repl (add-text-to-store %store "bash" "fake bash"))
(grafted (graft-derivation %store orig
(list (graft
(origin %bash)
(replacement repl))))))
(and (build-derivations %store (list grafted))
(let ((one (derivation->output-path grafted "one"))
(two (derivation->output-path grafted "two")))
(and (string=? (readlink one) repl)
(string=? (readlink two) one))))))
(test-end)