diff options
| -rw-r--r-- | guix/derivations.scm | 26 | ||||
| -rw-r--r-- | tests/derivations.scm | 22 |
2 files changed, 41 insertions, 7 deletions
diff --git a/guix/derivations.scm b/guix/derivations.scm index b33e835556..63c1ba4f2b 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -674,17 +674,21 @@ recursively." (define input->output-paths (match-lambda - ((drv) + (((? derivation? drv)) (list (derivation->output-path drv))) - ((drv sub-drvs ...) + (((? derivation? drv) sub-drvs ...) (map (cut derivation->output-path drv <>) - sub-drvs)))) + sub-drvs)) + ((file) + (list file)))) (let ((mapping (fold (lambda (pair result) (match pair - ((orig . replacement) + (((? derivation? orig) . replacement) (vhash-cons (derivation-file-name orig) - replacement result)))) + replacement result)) + ((file . replacement) + (vhash-cons file replacement result)))) vlist-null mapping))) (define rewritten-input @@ -695,8 +699,10 @@ recursively." (match input (($ <derivation-input> path (sub-drvs ...)) (match (vhash-assoc path mapping) - ((_ . replacement) + ((_ . (? derivation? replacement)) (cons replacement sub-drvs)) + ((_ . replacement) + (list replacement)) (#f (let* ((drv (loop (call-with-input-file path read-derivation)))) (cons drv sub-drvs))))))))) @@ -711,7 +717,13 @@ recursively." ;; Sources typically refer to the output directories of the ;; original inputs, INITIAL. Rewrite them by substituting ;; REPLACEMENTS. - (sources (map (cut substitute-file <> initial replacements) + (sources (map (lambda (source) + (match (vhash-assoc source mapping) + ((_ . replacement) + replacement) + (#f + (substitute-file source + initial replacements)))) (derivation-sources drv))) ;; Now augment the lists of initials and replacements. diff --git a/tests/derivations.scm b/tests/derivations.scm index 09cf81972c..a4e073bf07 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -720,6 +720,28 @@ Deriver: ~a~%" (and (build-derivations %store (list (pk 'remapped drv4))) (call-with-input-file out get-string-all)))) +(test-equal "map-derivation, sources" + "hello" + (let* ((script1 (add-text-to-store %store "fail.sh" "exit 1")) + (script2 (add-text-to-store %store "hi.sh" "echo -n hello > $out")) + (bash-full (package-derivation %store (@ (gnu packages bash) bash))) + (drv1 (derivation %store "drv-to-remap" + + ;; XXX: This wouldn't work in practice, but if + ;; we append "/bin/bash" then we can't replace + ;; it with the bootstrap bash, which is a + ;; single file. + (derivation->output-path bash-full) + + `("-e" ,script1) + #:inputs `((,bash-full) (,script1)))) + (drv2 (map-derivation %store drv1 + `((,bash-full . ,%bash) + (,script1 . ,script2)))) + (out (derivation->output-path drv2))) + (and (build-derivations %store (list (pk 'remapped* drv2))) + (call-with-input-file out get-string-all)))) + (test-end) |