futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

gexp: Native inputs of nested gexps are properly accounted for.

Browse Source 
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:
Ludovic Courtès 2016-12-19 17:06:12 +01:00
parent 9fc037fe10
commit 5b14a7902c
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 22 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
guix/gexp.scm
View File

@ -678,32 +678,28 @@ references; otherwise, return only non-native references."
(if (direct-store-path? str) (if (direct-store-path? str)
(cons `(,str) result) (cons `(,str) result)
result)) result))
(($ <gexp-input> (? struct? thing) output) (($ <gexp-input> (? struct? thing) output n?)
(if (lookup-compiler thing) (if (and (eqv? n? native?) (lookup-compiler thing))
;; 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 n?) (($ <gexp-input> (lst ...) output n?)
(fold-right add-reference-inputs result (if (eqv? native? n?)
;; XXX: For now, automatically convert LST to a list of (fold-right add-reference-inputs result
;; gexp-inputs. ;; XXX: For now, automatically convert LST to a list of
(map (match-lambda ;; gexp-inputs.
((? gexp-input? x) x) (map (match-lambda
(x (%gexp-input x "out" (or n? native?)))) ((? gexp-input? x) x)
lst))) (x (%gexp-input x "out" (or n? native?))))
lst))
result))
(_ (_
;; Ignore references to other kinds of objects. ;; Ignore references to other kinds of objects.
result))) result)))
(define (native-input? x)
(and (gexp-input? x)
(gexp-input-native? x)))
(fold-right add-reference-inputs (fold-right add-reference-inputs
'() '()
(if native? (gexp-references exp)))
(filter native-input? (gexp-references exp))
(remove native-input? (gexp-references exp)))))
(define gexp-native-inputs (define gexp-native-inputs
(cut gexp-inputs <> #:native? #t)) (cut gexp-inputs <> #:native? #t))

11
tests/gexp.scm
View File

@ -277,6 +277,14 @@
(ungexp %bootstrap-guile))))) (ungexp %bootstrap-guile)))))
(list (gexp-inputs exp) '<> (gexp-native-inputs exp)))) (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" (test-assert "input list"
(let ((exp (gexp (display (let ((exp (gexp (display
'(ungexp (list %bootstrap-guile coreutils))))) '(ungexp (list %bootstrap-guile coreutils)))))
@ -327,7 +335,8 @@
`(list ,@(cons 5 outputs)))))) `(list ,@(cons 5 outputs))))))
(test-assert "input list splicing + ungexp-native-splicing" (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)))))) (exp (gexp (list (ungexp-native-splicing (cons (+ 2 3) inputs))))))
(and (lset= equal? (and (lset= equal?
`((,glibc "debug") (,%bootstrap-guile "out")) `((,glibc "debug") (,%bootstrap-guile "out"))