summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2018-03-23 18:35:32 +0100
committerLudovic Courtès <ludo@gnu.org>2018-03-23 18:41:07 +0100
commit427ec19e8887b8036690734564a86496000e12a6 (patch)
treece9262cc6a68c9e1a3f23cc3024b32fe9a8d585f
parent1ae16033f34cebe802023922436883867010850f (diff)
gexp: 'program-file' has a new #:module-path parameter.
* guix/gexp.scm (<program-file>): Add 'path' field. (program-file): Add #:module-path parameter and honor it. (program-file-compiler): Honor the 'path' field. * tests/gexp.scm ("program-file #:module-path"): New test. * doc/guix.texi (G-Expressions): Update.
-rw-r--r--doc/guix.texi4
-rw-r--r--guix/gexp.scm16
-rw-r--r--tests/gexp.scm27
3 files changed, 39 insertions, 8 deletions
diff --git a/doc/guix.texi b/doc/guix.texi
index b765bcd112..7304d589d4 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -5179,10 +5179,10 @@ executable file @file{/gnu/store/@dots{}-list-files} along these lines:
@end deffn
@deffn {Scheme Procedure} program-file @var{name} @var{exp} @
- [#:guile #f]
+ [#:guile #f] [#:module-path %load-path]
Return an object representing the executable store item @var{name} that
runs @var{gexp}. @var{guile} is the Guile package used to execute that
-script.
+script. Imported modules of @var{gexp} are looked up in @var{module-path}.
This is the declarative counterpart of @code{gexp->script}.
@end deffn
diff --git a/guix/gexp.scm b/guix/gexp.scm
index 4a2e5a682e..b47965d9eb 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -60,6 +60,7 @@
program-file-name
program-file-gexp
program-file-guile
+ program-file-module-path
scheme-file
scheme-file?
@@ -380,25 +381,28 @@ This is the declarative counterpart of 'gexp->derivation'."
(apply gexp->derivation name gexp options)))))
(define-record-type <program-file>
- (%program-file name gexp guile)
+ (%program-file name gexp guile path)
program-file?
(name program-file-name) ;string
(gexp program-file-gexp) ;gexp
- (guile program-file-guile)) ;package
+ (guile program-file-guile) ;package
+ (path program-file-module-path)) ;list of strings
-(define* (program-file name gexp #:key (guile #f))
+(define* (program-file name gexp #:key (guile #f) (module-path %load-path))
"Return an object representing the executable store item NAME that runs
-GEXP. GUILE is the Guile package used to execute that script.
+GEXP. GUILE is the Guile package used to execute that script. Imported
+modules of GEXP are looked up in MODULE-PATH.
This is the declarative counterpart of 'gexp->script'."
- (%program-file name gexp guile))
+ (%program-file name gexp guile module-path))
(define-gexp-compiler (program-file-compiler (file <program-file>)
system target)
;; Compile FILE by returning a derivation that builds the script.
(match file
- (($ <program-file> name gexp guile)
+ (($ <program-file> name gexp guile module-path)
(gexp->script name gexp
+ #:module-path module-path
#:guile (or guile (default-guile))))))
(define-record-type <scheme-file>
diff --git a/tests/gexp.scm b/tests/gexp.scm
index a0198b13a0..2f8940e2c6 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -902,6 +902,33 @@
(return (and (zero? (close-pipe pipe))
(= n (string->number str)))))))))
+(test-assertm "program-file #:module-path"
+ (call-with-temporary-directory
+ (lambda (directory)
+ (define text (random-text))
+
+ (call-with-output-file (string-append directory "/stupid-module.scm")
+ (lambda (port)
+ (write `(begin (define-module (stupid-module))
+ (define-public %stupid-thing ,text))
+ port)))
+
+ (let* ((exp (with-imported-modules '((stupid-module))
+ (gexp (begin
+ (use-modules (stupid-module))
+ (display %stupid-thing)))))
+ (file (program-file "program" exp
+ #:guile %bootstrap-guile
+ #:module-path (list directory))))
+ (mlet* %store-monad ((drv (lower-object file))
+ (out -> (derivation->output-path drv)))
+ (mbegin %store-monad
+ (built-derivations (list drv))
+ (let* ((pipe (open-input-pipe out))
+ (str (get-string-all pipe)))
+ (return (and (zero? (close-pipe pipe))
+ (string=? text str))))))))))
+
(test-assertm "scheme-file"
(let* ((text (plain-file "foo" "Hello, world!"))
(scheme (scheme-file "bar" #~(list "foo" #$text))))