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'.
This commit is contained in:
parent
9fc037fe10
commit
5b14a7902c
|
@ -678,32 +678,28 @@ references; otherwise, return only non-native references."
|
|||
(if (direct-store-path? str)
|
||||
(cons `(,str) result)
|
||||
result))
|
||||
(($ <gexp-input> (? struct? thing) output)
|
||||
(if (lookup-compiler thing)
|
||||
(($ <gexp-input> (? 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))
|
||||
(($ <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" (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))
|
||||
|
|
|
@ -277,6 +277,14 @@
|
|||
(ungexp %bootstrap-guile)))))
|
||||
(list (gexp-inputs exp) '<> (gexp-native-inputs exp))))
|
||||
|
||||
(test-equal "ungexp + ungexp-native, nested, special mixture"
|
||||
`(() <> ((,coreutils "out")))
|
||||
|
||||
;; (gexp-native-inputs exp) used to return '(), wrongfully.
|
||||
(let* ((foo (gexp (foo (ungexp-native coreutils))))
|
||||
(exp (gexp (bar (ungexp foo)))))
|
||||
(list (gexp-inputs exp) '<> (gexp-native-inputs exp))))
|
||||
|
||||
(test-assert "input list"
|
||||
(let ((exp (gexp (display
|
||||
'(ungexp (list %bootstrap-guile coreutils)))))
|
||||
|
@ -327,7 +335,8 @@
|
|||
`(list ,@(cons 5 outputs))))))
|
||||
|
||||
(test-assert "input list splicing + ungexp-native-splicing"
|
||||
(let* ((inputs (list (gexp-input glibc "debug") %bootstrap-guile))
|
||||
(let* ((inputs (list (gexp-input glibc "debug" #:native? #t)
|
||||
%bootstrap-guile))
|
||||
(exp (gexp (list (ungexp-native-splicing (cons (+ 2 3) inputs))))))
|
||||
(and (lset= equal?
|
||||
`((,glibc "debug") (,%bootstrap-guile "out"))
|
||||
|
|
Loading…
Reference in New Issue