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)