mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -05:00
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
2 changed files with 41 additions and 7 deletions
|
@ -674,17 +674,21 @@ (define contents
|
|||
|
||||
(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 @@ (define rewritten-input
|
|||
(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 @@ (define rewritten-input
|
|||
;; 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.
|
||||
|
|
|
@ -720,6 +720,28 @@ (define (deps path . deps)
|
|||
(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)
|
||||
|
||||
|
||||
|
|
Loading…
Reference in a new issue