From f376dc3acb69a7345a7e945a37a78f63ac626edb Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 27 Feb 2016 23:28:35 +0100 Subject: 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. --- guix/grafts.scm | 23 +++++++++++++++-------- 1 file changed, 15 insertions(+), 8 deletions(-) (limited to 'guix') 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)))))) -- cgit v1.2.3