02/02: gexp: 'program-file' has a new #:module-path parameter.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 427ec19e8887b8036690734564a86496000e12a6
Author: Ludovic Courtès <address@hidden>
Date:   Fri Mar 23 18:35:32 2018 +0100

    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.
---
 doc/guix.texi  |  4 ++--
 guix/gexp.scm  | 16 ++++++++++------
 tests/gexp.scm | 27 +++++++++++++++++++++++++++
 3 files changed, 39 insertions(+), 8 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index b765bcd..7304d58 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 4a2e5a6..b47965d 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 a0198b1..2f8940e 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))))