me/guix
Archived
1
0
Fork 0
Code Activity

gexp: Fix handling of nativeness in nested gexps.

Browse source 
* 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.
This commit is contained in:
Ludovic Courtès 2015-03-22 23:17:37 +01:00
parent 607e1b51f4
commit 1123759b45
2 changed files with 27 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

30
guix/gexp.scm
View file

@ -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."

6
tests/gexp.scm
View file

@ -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)))))