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

gexp: 'gexp-modules' accepts plain Scheme objects. 

* guix/gexp.scm (gexp-modules): Return '() when not (gexp? GEXP).
* tests/gexp.scm ("gexp-modules and literal Scheme object"): New test.
This commit is contained in:
Ludovic Courtès 2017-04-19 16:11:25 +02:00
parent f2767d3e89
commit 2363bdd707
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 22 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
guix/gexp.scm
View File

@ -459,21 +459,24 @@ whether this should be considered a \"native\" input or not."
(set-record-type-printer! <gexp-output> write-gexp-output) (set-record-type-printer! <gexp-output> write-gexp-output)
(define (gexp-modules gexp) (define (gexp-modules gexp)
"Return the list of Guile module names GEXP relies on." "Return the list of Guile module names GEXP relies on. If (gexp? GEXP) is
(delete-duplicates false, meaning that GEXP is a plain Scheme object, return the empty list."
(append (gexp-self-modules gexp) (if (gexp? gexp)
(append-map (match-lambda (delete-duplicates
(($ <gexp-input> (? gexp? exp)) (append (gexp-self-modules gexp)
(gexp-modules exp)) (append-map (match-lambda
(($ <gexp-input> (lst ...)) (($ <gexp-input> (? gexp? exp))
(append-map (lambda (item) (gexp-modules exp))
(if (gexp? item) (($ <gexp-input> (lst ...))
(gexp-modules item) (append-map (lambda (item)
'())) (if (gexp? item)
lst)) (gexp-modules item)
(_ '()))
'())) lst))
(gexp-references gexp))))) (_
'()))
(gexp-references gexp))))
'())) ;plain Scheme data type
(define* (lower-inputs inputs (define* (lower-inputs inputs
#:key system target) #:key system target)

4
tests/gexp.scm
View File

@ -627,6 +627,10 @@
#~(foo #$@(list (with-imported-modules '((foo)) #~+) #~(foo #$@(list (with-imported-modules '((foo)) #~+)
(with-imported-modules '((bar)) #~-))))) (with-imported-modules '((bar)) #~-)))))
(test-equal "gexp-modules and literal Scheme object"
'()
(gexp-modules #t))
(test-assertm "gexp->derivation #:modules" (test-assertm "gexp->derivation #:modules"
(mlet* %store-monad (mlet* %store-monad
((build -> #~(begin ((build -> #~(begin