summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-03-22 23:17:37 +0100
committerLudovic Courtès <ludo@gnu.org>2015-03-22 23:18:33 +0100
commit1123759b4549bedc1a44b5d59a30c886e58ff6bc (patch)
treeceb5057c973ca543c5eadbe79bb767132ebc4dd4
parent607e1b51f4b473e69373b9887555d7f6abd4cf10 (diff)
downloadgnu-guix-1123759b4549bedc1a44b5d59a30c886e58ff6bc.tar
gnu-guix-1123759b4549bedc1a44b5d59a30c886e58ff6bc.tar.gz
gexp: Fix handling of nativeness in nested gexps.
* guix/gexp.scm (gexp-inputs): Remove 'references' parameter; add #:native? and honor it. [add-reference-inputs]: Distinguish between native gexp inputs, and non-native gexp inputs. Honor 'native?' field of list inputs. * tests/gexp.scm ("ungexp + ungexp-native, nested"): New test.
-rw-r--r--guix/gexp.scm30
-rw-r--r--tests/gexp.scm6
2 files changed, 27 insertions, 9 deletions
diff --git a/guix/gexp.scm b/guix/gexp.scm
index 3081ab0653..01290dba18 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -353,13 +353,23 @@ The other arguments are as for 'derivation'."
#:allowed-references allowed
#:local-build? local-build?))))
-(define* (gexp-inputs exp #:optional (references gexp-references))
- "Return the input list for EXP, using REFERENCES to get its list of
-references."
+(define* (gexp-inputs exp #:key native?)
+ "Return the input list for EXP. When NATIVE? is true, return only native
+references; otherwise, return only non-native references."
(define (add-reference-inputs ref result)
(match ref
- (($ <gexp-input> (? gexp? exp))
- (append (gexp-inputs exp references) result))
+ (($ <gexp-input> (? gexp? exp) _ #t)
+ (if native?
+ (append (gexp-inputs exp)
+ (gexp-inputs exp #:native? #t)
+ result)
+ result))
+ (($ <gexp-input> (? gexp? exp) _ #f)
+ (if native?
+ (append (gexp-inputs exp #:native? #t)
+ result)
+ (append (gexp-inputs exp)
+ result)))
(($ <gexp-input> (? string? str))
(if (direct-store-path? str)
(cons `(,str) result)
@@ -369,13 +379,13 @@ references."
;; THING is a derivation, or a package, or an origin, etc.
(cons `(,thing ,output) result)
result))
- (($ <gexp-input> (lst ...) output native?)
+ (($ <gexp-input> (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" native?)))
+ (x (%gexp-input x "out" (or n? native?))))
lst)))
(_
;; Ignore references to other kinds of objects.
@@ -383,10 +393,12 @@ references."
(fold-right add-reference-inputs
'()
- (references exp)))
+ (if native?
+ (gexp-native-references exp)
+ (gexp-references exp))))
(define gexp-native-inputs
- (cut gexp-inputs <> gexp-native-references))
+ (cut gexp-inputs <> #:native? #t))
(define (gexp-outputs exp)
"Return the outputs referred to by EXP as a list of strings."
diff --git a/tests/gexp.scm b/tests/gexp.scm
index 27c08467e7..0540969503 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -160,6 +160,12 @@
(equal? `(list ,guile ,cu ,libc ,bu)
(gexp->sexp* exp target)))))
+(test-equal "ungexp + ungexp-native, nested"
+ (list `((,%bootstrap-guile "out")) '<> `((,coreutils "out")))
+ (let* ((exp (gexp (list (ungexp-native (gexp (ungexp coreutils)))
+ (ungexp %bootstrap-guile)))))
+ (list (gexp-inputs exp) '<> (gexp-native-inputs exp))))
+
(test-assert "input list"
(let ((exp (gexp (display
'(ungexp (list %bootstrap-guile coreutils)))))