summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2016-02-27 23:28:35 +0100
committerLudovic Courtès <ludo@gnu.org>2016-02-27 23:31:52 +0100
commitf376dc3acb69a7345a7e945a37a78f63ac626edb (patch)
tree03c9178ef71bf7db808823bbd60a5588512375ff
parentcd05d388121d6a9d7ee83aefa29d3c3b255b7552 (diff)
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.
-rw-r--r--guix/grafts.scm23
-rw-r--r--tests/grafts.scm20
2 files changed, 35 insertions, 8 deletions
diff --git a/guix/grafts.scm b/guix/grafts.scm
index 339f273b76..ea53959b37 100644
--- a/guix/grafts.scm
+++ b/guix/grafts.scm
@@ -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))))))
diff --git a/tests/grafts.scm b/tests/grafts.scm
index 4a4122a3e9..9fe314d183 100644
--- a/tests/grafts.scm
+++ b/tests/grafts.scm
@@ -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)