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.
This commit is contained in:
parent
1ae16033f3
commit
427ec19e88
|
@ -5179,10 +5179,10 @@ executable file @file{/gnu/store/@dots{}-list-files} along these lines:
|
||||||
@end deffn
|
@end deffn
|
||||||
|
|
||||||
@deffn {Scheme Procedure} program-file @var{name} @var{exp} @
|
@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
|
Return an object representing the executable store item @var{name} that
|
||||||
runs @var{gexp}. @var{guile} is the Guile package used to execute 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}.
|
This is the declarative counterpart of @code{gexp->script}.
|
||||||
@end deffn
|
@end deffn
|
||||||
|
|
|
@ -60,6 +60,7 @@
|
||||||
program-file-name
|
program-file-name
|
||||||
program-file-gexp
|
program-file-gexp
|
||||||
program-file-guile
|
program-file-guile
|
||||||
|
program-file-module-path
|
||||||
|
|
||||||
scheme-file
|
scheme-file
|
||||||
scheme-file?
|
scheme-file?
|
||||||
|
@ -380,25 +381,28 @@ This is the declarative counterpart of 'gexp->derivation'."
|
||||||
(apply gexp->derivation name gexp options)))))
|
(apply gexp->derivation name gexp options)))))
|
||||||
|
|
||||||
(define-record-type <program-file>
|
(define-record-type <program-file>
|
||||||
(%program-file name gexp guile)
|
(%program-file name gexp guile path)
|
||||||
program-file?
|
program-file?
|
||||||
(name program-file-name) ;string
|
(name program-file-name) ;string
|
||||||
(gexp program-file-gexp) ;gexp
|
(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
|
"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'."
|
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>)
|
(define-gexp-compiler (program-file-compiler (file <program-file>)
|
||||||
system target)
|
system target)
|
||||||
;; Compile FILE by returning a derivation that builds the script.
|
;; Compile FILE by returning a derivation that builds the script.
|
||||||
(match file
|
(match file
|
||||||
(($ <program-file> name gexp guile)
|
(($ <program-file> name gexp guile module-path)
|
||||||
(gexp->script name gexp
|
(gexp->script name gexp
|
||||||
|
#:module-path module-path
|
||||||
#:guile (or guile (default-guile))))))
|
#:guile (or guile (default-guile))))))
|
||||||
|
|
||||||
(define-record-type <scheme-file>
|
(define-record-type <scheme-file>
|
||||||
|
|
|
@ -902,6 +902,33 @@
|
||||||
(return (and (zero? (close-pipe pipe))
|
(return (and (zero? (close-pipe pipe))
|
||||||
(= n (string->number str)))))))))
|
(= 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"
|
(test-assertm "scheme-file"
|
||||||
(let* ((text (plain-file "foo" "Hello, world!"))
|
(let* ((text (plain-file "foo" "Hello, world!"))
|
||||||
(scheme (scheme-file "bar" #~(list "foo" #$text))))
|
(scheme (scheme-file "bar" #~(list "foo" #$text))))
|
||||||
|
|
Loading…
Reference in New Issue