gexp: 'program-file' honors the current system and cross-compilation target.
Fixes <https://bugs.gnu.org/36813>. Reported by Jakob L. Kreuze <zerodaysfordays.sdf.org@sdf.org>. * guix/gexp.scm (program-file-compiler): Pass #:system and #:target to 'gexp->script'. (load-path-expression): Add #:system and #:target and honor them. (gexp->script): Likewise. * tests/gexp.scm ("program-file #:system"): New test. * doc/guix.texi (G-Expressions): Adjust accordingly.
This commit is contained in:
parent
2cc5ec7f0d
commit
2e8cabb8d6
|
@ -7439,7 +7439,8 @@ This is the declarative counterpart of @code{gexp->derivation}.
|
||||||
@end deffn
|
@end deffn
|
||||||
|
|
||||||
@deffn {Monadic Procedure} gexp->script @var{name} @var{exp} @
|
@deffn {Monadic Procedure} gexp->script @var{name} @var{exp} @
|
||||||
[#:guile (default-guile)] [#:module-path %load-path]
|
[#:guile (default-guile)] [#:module-path %load-path] @
|
||||||
|
[#:system (%current-system)] [#:target #f]
|
||||||
Return an executable script @var{name} that runs @var{exp} using
|
Return an executable script @var{name} that runs @var{exp} using
|
||||||
@var{guile}, with @var{exp}'s imported modules in its search path.
|
@var{guile}, with @var{exp}'s imported modules in its search path.
|
||||||
Look up @var{exp}'s modules in @var{module-path}.
|
Look up @var{exp}'s modules in @var{module-path}.
|
||||||
|
|
|
@ -427,7 +427,9 @@ This is the declarative counterpart of 'gexp->script'."
|
||||||
(($ <program-file> name gexp guile module-path)
|
(($ <program-file> name gexp guile module-path)
|
||||||
(gexp->script name gexp
|
(gexp->script name gexp
|
||||||
#:module-path module-path
|
#:module-path module-path
|
||||||
#:guile (or guile (default-guile))))))
|
#:guile (or guile (default-guile))
|
||||||
|
#:system system
|
||||||
|
#:target target))))
|
||||||
|
|
||||||
(define-record-type <scheme-file>
|
(define-record-type <scheme-file>
|
||||||
(%scheme-file name gexp splice?)
|
(%scheme-file name gexp splice?)
|
||||||
|
@ -1512,7 +1514,7 @@ TARGET, a GNU triplet."
|
||||||
'guile-2.2))
|
'guile-2.2))
|
||||||
|
|
||||||
(define* (load-path-expression modules #:optional (path %load-path)
|
(define* (load-path-expression modules #:optional (path %load-path)
|
||||||
#:key (extensions '()))
|
#:key (extensions '()) system target)
|
||||||
"Return as a monadic value a gexp that sets '%load-path' and
|
"Return as a monadic value a gexp that sets '%load-path' and
|
||||||
'%load-compiled-path' to point to MODULES, a list of module names. MODULES
|
'%load-compiled-path' to point to MODULES, a list of module names. MODULES
|
||||||
are searched for in PATH. Return #f when MODULES and EXTENSIONS are empty."
|
are searched for in PATH. Return #f when MODULES and EXTENSIONS are empty."
|
||||||
|
@ -1520,10 +1522,13 @@ are searched for in PATH. Return #f when MODULES and EXTENSIONS are empty."
|
||||||
(with-monad %store-monad
|
(with-monad %store-monad
|
||||||
(return #f))
|
(return #f))
|
||||||
(mlet %store-monad ((modules (imported-modules modules
|
(mlet %store-monad ((modules (imported-modules modules
|
||||||
#:module-path path))
|
#:module-path path
|
||||||
|
#:system system))
|
||||||
(compiled (compiled-modules modules
|
(compiled (compiled-modules modules
|
||||||
#:extensions extensions
|
#:extensions extensions
|
||||||
#:module-path path)))
|
#:module-path path
|
||||||
|
#:system system
|
||||||
|
#:target target)))
|
||||||
(return (gexp (eval-when (expand load eval)
|
(return (gexp (eval-when (expand load eval)
|
||||||
(set! %load-path
|
(set! %load-path
|
||||||
(cons (ungexp modules)
|
(cons (ungexp modules)
|
||||||
|
@ -1545,14 +1550,18 @@ are searched for in PATH. Return #f when MODULES and EXTENSIONS are empty."
|
||||||
|
|
||||||
(define* (gexp->script name exp
|
(define* (gexp->script name exp
|
||||||
#:key (guile (default-guile))
|
#:key (guile (default-guile))
|
||||||
(module-path %load-path))
|
(module-path %load-path)
|
||||||
|
(system (%current-system))
|
||||||
|
target)
|
||||||
"Return an executable script NAME that runs EXP using GUILE, with EXP's
|
"Return an executable script NAME that runs EXP using GUILE, with EXP's
|
||||||
imported modules in its search path. Look up EXP's modules in MODULE-PATH."
|
imported modules in its search path. Look up EXP's modules in MODULE-PATH."
|
||||||
(mlet %store-monad ((set-load-path
|
(mlet %store-monad ((set-load-path
|
||||||
(load-path-expression (gexp-modules exp)
|
(load-path-expression (gexp-modules exp)
|
||||||
module-path
|
module-path
|
||||||
#:extensions
|
#:extensions
|
||||||
(gexp-extensions exp))))
|
(gexp-extensions exp)
|
||||||
|
#:system system
|
||||||
|
#:target target)))
|
||||||
(gexp->derivation name
|
(gexp->derivation name
|
||||||
(gexp
|
(gexp
|
||||||
(call-with-output-file (ungexp output)
|
(call-with-output-file (ungexp output)
|
||||||
|
@ -1572,6 +1581,8 @@ imported modules in its search path. Look up EXP's modules in MODULE-PATH."
|
||||||
|
|
||||||
(write '(ungexp exp) port)
|
(write '(ungexp exp) port)
|
||||||
(chmod port #o555))))
|
(chmod port #o555))))
|
||||||
|
#:system system
|
||||||
|
#:target target
|
||||||
#:module-path module-path)))
|
#:module-path module-path)))
|
||||||
|
|
||||||
(define* (gexp->file name exp #:key
|
(define* (gexp->file name exp #:key
|
||||||
|
|
|
@ -1104,6 +1104,25 @@
|
||||||
(return (and (zero? (close-pipe pipe))
|
(return (and (zero? (close-pipe pipe))
|
||||||
(= 42 (string->number str)))))))))
|
(= 42 (string->number str)))))))))
|
||||||
|
|
||||||
|
(test-assertm "program-file #:system"
|
||||||
|
(let* ((exp (with-imported-modules '((guix build utils))
|
||||||
|
(gexp (begin
|
||||||
|
(use-modules (guix build utils))
|
||||||
|
(display "hi!")))))
|
||||||
|
(system (if (string=? (%current-system) "x86_64-linux")
|
||||||
|
"armhf-linux"
|
||||||
|
"x86_64-linux"))
|
||||||
|
(file (program-file "program" exp)))
|
||||||
|
(mlet %store-monad ((drv (lower-object file system)))
|
||||||
|
(return (and (string=? (derivation-system drv) system)
|
||||||
|
(find (lambda (input)
|
||||||
|
(let ((drv (pk (derivation-input-derivation input))))
|
||||||
|
(and (string=? (derivation-name drv)
|
||||||
|
"module-import-compiled")
|
||||||
|
(string=? (derivation-system drv)
|
||||||
|
system))))
|
||||||
|
(derivation-inputs drv)))))))
|
||||||
|
|
||||||
(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