[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
02/03: gexp: 'gexp-modules' accepts plain Scheme objects.
From: |
Ludovic Courtès |
Subject: |
02/03: gexp: 'gexp-modules' accepts plain Scheme objects. |
Date: |
Wed, 19 Apr 2017 11:52:41 -0400 (EDT) |
civodul pushed a commit to branch master
in repository guix.
commit 2363bdd707ba382d89c96e03c04038c047d7228c
Author: Ludovic Courtès <address@hidden>
Date: Wed Apr 19 16:11:25 2017 +0200
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.
---
guix/gexp.scm | 33 ++++++++++++++++++---------------
tests/gexp.scm | 4 ++++
2 files changed, 22 insertions(+), 15 deletions(-)
diff --git a/guix/gexp.scm b/guix/gexp.scm
index 80d8f73..d9c4cb4 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -459,21 +459,24 @@ whether this should be considered a \"native\" input or
not."
(set-record-type-printer! <gexp-output> write-gexp-output)
(define (gexp-modules gexp)
- "Return the list of Guile module names GEXP relies on."
- (delete-duplicates
- (append (gexp-self-modules gexp)
- (append-map (match-lambda
- (($ <gexp-input> (? gexp? exp))
- (gexp-modules exp))
- (($ <gexp-input> (lst ...))
- (append-map (lambda (item)
- (if (gexp? item)
- (gexp-modules item)
- '()))
- lst))
- (_
- '()))
- (gexp-references gexp)))))
+ "Return the list of Guile module names GEXP relies on. If (gexp? GEXP) is
+false, meaning that GEXP is a plain Scheme object, return the empty list."
+ (if (gexp? gexp)
+ (delete-duplicates
+ (append (gexp-self-modules gexp)
+ (append-map (match-lambda
+ (($ <gexp-input> (? gexp? exp))
+ (gexp-modules exp))
+ (($ <gexp-input> (lst ...))
+ (append-map (lambda (item)
+ (if (gexp? item)
+ (gexp-modules item)
+ '()))
+ lst))
+ (_
+ '()))
+ (gexp-references gexp))))
+ '())) ;plain Scheme data type
(define* (lower-inputs inputs
#:key system target)
diff --git a/tests/gexp.scm b/tests/gexp.scm
index 41a53ae..cf88a9d 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -627,6 +627,10 @@
#~(foo #$@(list (with-imported-modules '((foo)) #~+)
(with-imported-modules '((bar)) #~-)))))
+(test-equal "gexp-modules and literal Scheme object"
+ '()
+ (gexp-modules #t))
+
(test-assertm "gexp->derivation #:modules"
(mlet* %store-monad
((build -> #~(begin