derivations: Allow 'map-derivations' to replace sources.
* guix/derivations.scm (map-derivation)[input->output-paths]: Allow non-derivation inputs. Allow replacements to be store files. Replace in SOURCES too. * tests/derivations.scm ("map-derivation, sources"): New test.
This commit is contained in:
parent
f80594cc41
commit
a716e36de9
|
@ -674,17 +674,21 @@ recursively."
|
||||||
|
|
||||||
(define input->output-paths
|
(define input->output-paths
|
||||||
(match-lambda
|
(match-lambda
|
||||||
((drv)
|
(((? derivation? drv))
|
||||||
(list (derivation->output-path drv)))
|
(list (derivation->output-path drv)))
|
||||||
((drv sub-drvs ...)
|
(((? derivation? drv) sub-drvs ...)
|
||||||
(map (cut derivation->output-path drv <>)
|
(map (cut derivation->output-path drv <>)
|
||||||
sub-drvs))))
|
sub-drvs))
|
||||||
|
((file)
|
||||||
|
(list file))))
|
||||||
|
|
||||||
(let ((mapping (fold (lambda (pair result)
|
(let ((mapping (fold (lambda (pair result)
|
||||||
(match pair
|
(match pair
|
||||||
((orig . replacement)
|
(((? derivation? orig) . replacement)
|
||||||
(vhash-cons (derivation-file-name orig)
|
(vhash-cons (derivation-file-name orig)
|
||||||
replacement result))))
|
replacement result))
|
||||||
|
((file . replacement)
|
||||||
|
(vhash-cons file replacement result))))
|
||||||
vlist-null
|
vlist-null
|
||||||
mapping)))
|
mapping)))
|
||||||
(define rewritten-input
|
(define rewritten-input
|
||||||
|
@ -695,8 +699,10 @@ recursively."
|
||||||
(match input
|
(match input
|
||||||
(($ <derivation-input> path (sub-drvs ...))
|
(($ <derivation-input> path (sub-drvs ...))
|
||||||
(match (vhash-assoc path mapping)
|
(match (vhash-assoc path mapping)
|
||||||
((_ . replacement)
|
((_ . (? derivation? replacement))
|
||||||
(cons replacement sub-drvs))
|
(cons replacement sub-drvs))
|
||||||
|
((_ . replacement)
|
||||||
|
(list replacement))
|
||||||
(#f
|
(#f
|
||||||
(let* ((drv (loop (call-with-input-file path read-derivation))))
|
(let* ((drv (loop (call-with-input-file path read-derivation))))
|
||||||
(cons drv sub-drvs)))))))))
|
(cons drv sub-drvs)))))))))
|
||||||
|
@ -711,7 +717,13 @@ recursively."
|
||||||
;; Sources typically refer to the output directories of the
|
;; Sources typically refer to the output directories of the
|
||||||
;; original inputs, INITIAL. Rewrite them by substituting
|
;; original inputs, INITIAL. Rewrite them by substituting
|
||||||
;; REPLACEMENTS.
|
;; 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)))
|
(derivation-sources drv)))
|
||||||
|
|
||||||
;; Now augment the lists of initials and replacements.
|
;; Now augment the lists of initials and replacements.
|
||||||
|
|
|
@ -720,6 +720,28 @@ Deriver: ~a~%"
|
||||||
(and (build-derivations %store (list (pk 'remapped drv4)))
|
(and (build-derivations %store (list (pk 'remapped drv4)))
|
||||||
(call-with-input-file out get-string-all))))
|
(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)
|
(test-end)
|
||||||
|
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue