From e387ab7c10b18427b97cd22526f1b135856a083e Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 13 Nov 2013 00:25:57 +0100 Subject: derivations: Add 'map-derivation'. * guix/derivations.scm (map-derivation): New procedure. * tests/derivations.scm ("map-derivation"): New test. --- tests/derivations.scm | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) (limited to 'tests/derivations.scm') diff --git a/tests/derivations.scm b/tests/derivations.scm index 273db22765..09cf81972c 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -26,6 +26,7 @@ #:use-module ((guix packages) #:select (package-derivation)) #:use-module ((gnu packages) #:select (search-bootstrap-binary)) #:use-module (gnu packages bootstrap) + #:use-module ((gnu packages guile) #:select (guile-1.8)) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) @@ -690,6 +691,35 @@ Deriver: ~a~%" ((p2 . _) (stringderivation %store "original-drv1" + (%current-system) + #f ; systematically fail + '() + #:guile-for-build joke)) + (drv2 (build-expression->derivation %store "original-drv2" + (%current-system) + '(call-with-output-file %output + (lambda (p) + (display "hello" p))) + '())) + (drv3 (build-expression->derivation %store "drv-to-remap" + (%current-system) + '(let ((in (assoc-ref + %build-inputs "in"))) + (copy-file in %output)) + `(("in" ,drv1)) + #:guile-for-build joke)) + (drv4 (map-derivation %store drv3 `((,drv1 . ,drv2) + (,joke . ,good)))) + (out (derivation->output-path drv4))) + (and (build-derivations %store (list (pk 'remapped drv4))) + (call-with-input-file out get-string-all)))) + (test-end) -- cgit 1.4.1 From a716e36de915a275e4eab42b73cf0a2affc4aa33 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 13 Nov 2013 11:22:07 +0100 Subject: 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. --- guix/derivations.scm | 26 +++++++++++++++++++------- tests/derivations.scm | 22 ++++++++++++++++++++++ 2 files changed, 41 insertions(+), 7 deletions(-) (limited to 'tests/derivations.scm') 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 (($ 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) -- cgit 1.4.1