From 5b14a7902c58d9fb7923f9e16871f549fbe59b6e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Mon, 19 Dec 2016 17:06:12 +0100 Subject: gexp: Native inputs of nested gexps are properly accounted for. Previously, 'gexp-native-inputs' would not return the native inputs of nested gexps. For example, this: (gexp-native-inputs #~(foo #$#~(bar #+coreutils))) would return '(). * guix/gexp.scm (gexp-inputs)[add-reference-inputs]: In the non-recursive cases, check whether N? and NATIVE? are the same, and act accordingly. [native-input?]: Remove. Fold over all of (gexp-references exp). * tests/gexp.scm ("ungexp + ungexp-native, nested, special mixture"): New test. * tests/gexp.scm ("input list splicing + ungexp-native-splicing"): Pass #:native? #t to 'gexp-input'. --- guix/gexp.scm | 28 ++++++++++++---------------- 1 file changed, 12 insertions(+), 16 deletions(-) (limited to 'guix/gexp.scm') diff --git a/guix/gexp.scm b/guix/gexp.scm index fd5dc49233..5021688ac7 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -678,32 +678,28 @@ references; otherwise, return only non-native references." (if (direct-store-path? str) (cons `(,str) result) result)) - (($ (? struct? thing) output) - (if (lookup-compiler thing) + (($ (? struct? thing) output n?) + (if (and (eqv? n? native?) (lookup-compiler thing)) ;; THING is a derivation, or a package, or an origin, etc. (cons `(,thing ,output) result) result)) (($ (lst ...) output n?) - (fold-right add-reference-inputs result - ;; XXX: For now, automatically convert LST to a list of - ;; gexp-inputs. - (map (match-lambda - ((? gexp-input? x) x) - (x (%gexp-input x "out" (or n? native?)))) - lst))) + (if (eqv? native? n?) + (fold-right add-reference-inputs result + ;; XXX: For now, automatically convert LST to a list of + ;; gexp-inputs. + (map (match-lambda + ((? gexp-input? x) x) + (x (%gexp-input x "out" (or n? native?)))) + lst)) + result)) (_ ;; Ignore references to other kinds of objects. result))) - (define (native-input? x) - (and (gexp-input? x) - (gexp-input-native? x))) - (fold-right add-reference-inputs '() - (if native? - (filter native-input? (gexp-references exp)) - (remove native-input? (gexp-references exp))))) + (gexp-references exp))) (define gexp-native-inputs (cut gexp-inputs <> #:native? #t)) -- cgit v1.2.3