nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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.
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 #:allowed-references allowed
#:local-build? local-build?)))) #:local-build? local-build?))))
(define* (gexp-inputs exp #:optional (references gexp-references)) (define* (gexp-inputs exp #:key native?)
"Return the input list for EXP, using REFERENCES to get its list of "Return the input list for EXP. When NATIVE? is true, return only native
references." references; otherwise, return only non-native references."
(define (add-reference-inputs ref result) (define (add-reference-inputs ref result)
(match ref (match ref
(($ <gexp-input> (? gexp? exp)) (($ <gexp-input> (? gexp? exp) _ #t)
(append (gexp-inputs exp references) result)) (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)) (($ <gexp-input> (? string? str))
(if (direct-store-path? str) (if (direct-store-path? str)
(cons `(,str) result) (cons `(,str) result)
@ -369,13 +379,13 @@ references."
;; THING is a derivation, or a package, or an origin, etc. ;; THING is a derivation, or a package, or an origin, etc.
(cons `(,thing ,output) result) (cons `(,thing ,output) result)
result)) result))
(($ <gexp-input> (lst ...) output native?) (($ <gexp-input> (lst ...) output n?)
(fold-right add-reference-inputs result (fold-right add-reference-inputs result
;; XXX: For now, automatically convert LST to a list of ;; XXX: For now, automatically convert LST to a list of
;; gexp-inputs. ;; gexp-inputs.
(map (match-lambda (map (match-lambda
((? gexp-input? x) x) ((? gexp-input? x) x)
(x (%gexp-input x "out" native?))) (x (%gexp-input x "out" (or n? native?))))
lst))) lst)))
(_ (_
;; Ignore references to other kinds of objects. ;; Ignore references to other kinds of objects.
@ -383,10 +393,12 @@ references."
(fold-right add-reference-inputs (fold-right add-reference-inputs
'() '()
(references exp))) (if native?
(gexp-native-references exp)
(gexp-references exp))))
(define gexp-native-inputs (define gexp-native-inputs
(cut gexp-inputs <> gexp-native-references)) (cut gexp-inputs <> #:native? #t))
(define (gexp-outputs exp) (define (gexp-outputs exp)
"Return the outputs referred to by EXP as a list of strings." "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) (equal? `(list ,guile ,cu ,libc ,bu)
(gexp->sexp* exp target))))) (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" (test-assert "input list"
(let ((exp (gexp (display (let ((exp (gexp (display
'(ungexp (list %bootstrap-guile coreutils))))) '(ungexp (list %bootstrap-guile coreutils)))))