2 files changed, 35 insertions(+), 8 deletions(-)

M guix/grafts.scm
M tests/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))))))

@@ 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)