From 1ae16033f34cebe802023922436883867010850f Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 23 Mar 2018 18:21:28 +0100 Subject: gexp: 'gexp->script' and 'gexp->file' have a new #:module-path parameter. * guix/gexp.scm (load-path-expression): Add 'path' optional parameter. (gexp->script): Add #:module-path and honor it. (gexp->file): Likewise. * tests/gexp.scm ("gexp->script #:module-path"): New test. * doc/guix.texi (G-Expressions): Update accordingly. --- tests/gexp.scm | 34 +++++++++++++++++++++++++++++++++- 1 file changed, 33 insertions(+), 1 deletion(-) (limited to 'tests/gexp.scm') diff --git a/tests/gexp.scm b/tests/gexp.scm index 5873abdd41..a0198b13a0 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès +;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -25,6 +25,7 @@ #:use-module (guix packages) #:use-module (guix tests) #:use-module ((guix build utils) #:select (with-directory-excursion)) + #:use-module ((guix utils) #:select (call-with-temporary-directory)) #:use-module (gnu packages) #:use-module (gnu packages base) #:use-module (gnu packages bootstrap) @@ -853,6 +854,37 @@ (return (and (zero? (close-pipe pipe)) (= (expt n 2) (string->number str))))))) +(test-assertm "gexp->script #:module-path" + (call-with-temporary-directory + (lambda (directory) + (define str + "Fake (guix base32) module!") + + (mkdir (string-append directory "/guix")) + (call-with-output-file (string-append directory "/guix/base32.scm") + (lambda (port) + (write `(begin (define-module (guix base32)) + (define-public %fake! ,str)) + port))) + + (mlet* %store-monad ((exp -> (with-imported-modules '((guix base32)) + (gexp (begin + (use-modules (guix base32)) + (write (list %load-path + %fake!)))))) + (drv (gexp->script "guile-thing" exp + #:guile %bootstrap-guile + #:module-path (list directory))) + (out -> (derivation->output-path drv)) + (done (built-derivations (list drv)))) + (let* ((pipe (open-input-pipe out)) + (data (read pipe))) + (return (and (zero? (close-pipe pipe)) + (match data + ((load-path str*) + (and (string=? str* str) + (not (member directory load-path)))))))))))) + (test-assertm "program-file" (let* ((n (random (expt 2 50))) (exp (with-imported-modules '((guix build utils)) -- cgit v1.2.3 From 427ec19e8887b8036690734564a86496000e12a6 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 23 Mar 2018 18:35:32 +0100 Subject: gexp: 'program-file' has a new #:module-path parameter. * guix/gexp.scm (): 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(-) (limited to 'tests/gexp.scm') 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 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 ) system target) ;; Compile FILE by returning a derivation that builds the script. (match file - (($ name gexp guile) + (($ name gexp guile module-path) (gexp->script name gexp + #:module-path module-path #:guile (or guile (default-guile)))))) (define-record-type 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)))) -- cgit v1.2.3