From b30b838d5055e36be19d030db28838fec4474d98 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sat, 6 Apr 2024 23:03:26 +0200 Subject: [PATCH] =?UTF-8?q?gexp:=20Add=20#:guile=20parameter=20to=20?= =?UTF-8?q?=E2=80=98gexp->file=E2=80=99=20and=20=E2=80=98scheme-file?= =?UTF-8?q?=E2=80=99.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This brings ‘gexp->file’ in line with its documentation and mirrors what’s done for ‘gexp->script’ and ‘program-file’. Fixes . * guix/gexp.scm (gexp->file): Add #:guile, as was already documented. ()[guile]: New field. (scheme-file): Add #:guile. (scheme-file-compiler): Honor ‘guile’ field. * tests/gexp.scm ("gexp->file") ("gexp->file + file-append", "gexp->file + #:splice?") ("gexp->file, cross-compilation") ("gexp->file, cross-compilation with default target") Add #:guile to ‘gexp->file’ calls. ("gexp-modules deletes duplicates") ("gexp->derivation & with-imported-module & computed module") ("gexp->derivation & with-extensions", "scheme-file"): Likewise for ‘scheme-file’ calls. Change-Id: I47536063d5e411e561ec321e535267e92dd06044 Reported-by: Efraim Flashner Change-Id: I58d653c7fbe65c665bafcbd332ac9b264ddeab64 --- doc/guix.texi | 5 +++-- guix/gexp.scm | 19 ++++++++++++++----- tests/gexp.scm | 31 +++++++++++++++++++++---------- 3 files changed, 38 insertions(+), 17 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 3ad44b4acb..5827e0de14 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -12192,9 +12192,10 @@ The resulting file holds references to all the dependencies of @var{exp} or a subset thereof. @end deffn -@deffn {Procedure} scheme-file name exp [#:splice? #f] [#:set-load-path? #t] +@deffn {Procedure} scheme-file name exp [#:splice? #f] @ + [#:guile #f] [#:set-load-path? #t] Return an object representing the Scheme file @var{name} that contains -@var{exp}. +@var{exp}. @var{guile} is the Guile package used to produce that file. This is the declarative counterpart of @code{gexp->file}. @end deffn diff --git a/guix/gexp.scm b/guix/gexp.scm index 29819878fa..74b4c49f90 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014-2023 Ludovic Courtès +;;; Copyright © 2014-2024 Ludovic Courtès ;;; Copyright © 2018 Clément Lassieur ;;; Copyright © 2018 Jan Nieuwenhuizen ;;; Copyright © 2019, 2020 Mathieu Othacehe @@ -633,25 +633,29 @@ (define-gexp-compiler (program-file-compiler (file ) #:target target)))) (define-record-type - (%scheme-file name gexp splice? load-path?) + (%scheme-file name gexp splice? guile load-path?) scheme-file? (name scheme-file-name) ;string (gexp scheme-file-gexp) ;gexp (splice? scheme-file-splice?) ;Boolean + (guile scheme-file-guile) ;package (load-path? scheme-file-set-load-path?)) ;Boolean -(define* (scheme-file name gexp #:key splice? (set-load-path? #t)) +(define* (scheme-file name gexp + #:key splice? + guile (set-load-path? #t)) "Return an object representing the Scheme file NAME that contains GEXP. This is the declarative counterpart of 'gexp->file'." - (%scheme-file name gexp splice? set-load-path?)) + (%scheme-file name gexp splice? guile set-load-path?)) (define-gexp-compiler (scheme-file-compiler (file ) system target) ;; Compile FILE by returning a derivation that builds the file. (match file - (($ name gexp splice? set-load-path?) + (($ name gexp splice? guile set-load-path?) (gexp->file name gexp + #:guile (or guile (default-guile)) #:set-load-path? set-load-path? #:splice? splice? #:system system @@ -2019,6 +2023,7 @@ (define* (gexp->script name exp #:substitutable? #f))) (define* (gexp->file name exp #:key + (guile (default-guile)) (set-load-path? #t) (module-path %load-path) (splice? #f) @@ -2038,6 +2043,8 @@ (define extensions (gexp-extensions exp)) ((target (if (eq? target 'current) (current-target-system) (return target))) + (guile-for-build + (lower-object guile system #:target #f)) (no-load-path? -> (or (not set-load-path?) (and (null? modules) (null? extensions)))) @@ -2057,6 +2064,7 @@ (define extensions (gexp-extensions exp)) '(ungexp (if splice? exp (gexp ((ungexp exp))))))))) + #:guile-for-build guile-for-build #:local-build? #t #:substitutable? #f #:system system @@ -2073,6 +2081,7 @@ (define extensions (gexp-extensions exp)) exp (gexp ((ungexp exp))))))))) #:module-path module-path + #:guile-for-build guile-for-build #:local-build? #t #:substitutable? #f #:system system diff --git a/tests/gexp.scm b/tests/gexp.scm index 001786c13c..905009caee 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014-2023 Ludovic Courtès +;;; Copyright © 2014-2024 Ludovic Courtès ;;; Copyright © 2021-2022 Maxime Devos ;;; ;;; This file is part of GNU Guix. @@ -661,7 +661,8 @@ (define (match-input thing) (mlet* %store-monad ((exp -> (gexp (display (ungexp %bootstrap-guile)))) (guile (package-file %bootstrap-guile)) (sexp (gexp->sexp exp (%current-system) #f)) - (drv (gexp->file "foo" exp)) + (drv (gexp->file "foo" exp + #:guile %bootstrap-guile)) (out -> (derivation->output-path drv)) (done (built-derivations (list drv))) (refs (references* out))) @@ -672,7 +673,8 @@ (define (match-input thing) (mlet* %store-monad ((exp -> #~#$(file-append %bootstrap-guile "/bin/guile")) (guile (package-file %bootstrap-guile)) - (drv (gexp->file "foo" exp)) + (drv (gexp->file "foo" exp + #:guile %bootstrap-guile)) (out -> (derivation->output-path drv)) (done (built-derivations (list drv))) (refs (references* out))) @@ -685,7 +687,9 @@ (define (match-input thing) #~(define foo 'bar) #~(define guile #$%bootstrap-guile))) (guile (package-file %bootstrap-guile)) - (drv (gexp->file "splice" exp #:splice? #t)) + (drv (gexp->file "splice" exp + #:splice? #t + #:guile %bootstrap-guile)) (out -> (derivation->output-path drv)) (done (built-derivations (list drv))) (refs (references* out))) @@ -943,7 +947,8 @@ (define (canonical-file? file) (let ((make-file (lambda () ;; Use 'eval' to make sure we get an object that's not ;; 'eq?' nor 'equal?' due to the closures it embeds. - (eval '(scheme-file "bar.scm" #~(define-module (bar))) + (eval '(scheme-file "bar.scm" #~(define-module (bar)) + #:guile %bootstrap-guile) (current-module))))) (define result ((@@ (guix gexp) gexp-modules) @@ -1035,7 +1040,8 @@ (define-module (foo bar) #:export (the-answer)) (define the-answer 42)) - #:splice? #t)) + #:splice? #t + #:guile %bootstrap-guile)) (build -> (with-imported-modules `(((foo bar) => ,module) (guix build utils)) #~(begin @@ -1080,7 +1086,8 @@ (define-module (foo) (define (multiply x) (* the-answer x))) - #:splice? #t)) + #:splice? #t + #:guile %bootstrap-guile)) (build -> (with-extensions (list extension) (with-imported-modules `((guix build utils) ((foo) => ,module)) @@ -1432,7 +1439,8 @@ (define-public %stupid-thing ,text)) (test-assertm "scheme-file" (let* ((text (plain-file "foo" "Hello, world!")) - (scheme (scheme-file "bar" #~(list "foo" #$text)))) + (scheme (scheme-file "bar" #~(list "foo" #$text) + #:guile %bootstrap-guile))) (mlet* %store-monad ((drv (lower-object scheme)) (text (lower-object text)) (out -> (derivation->output-path drv))) @@ -1719,7 +1727,9 @@ (define (contents=? file str) (test-assertm "gexp->file, cross-compilation" (mlet* %store-monad ((target -> "aarch64-linux-gnu") (exp -> (gexp (list (ungexp coreutils)))) - (xdrv (gexp->file "foo" exp #:target target)) + (xdrv (gexp->file "foo" exp + #:target target + #:guile %bootstrap-guile)) (refs (references* (derivation-file-name xdrv))) (xcu (package->cross-derivation coreutils @@ -1732,7 +1742,8 @@ (define (contents=? file str) (mlet* %store-monad ((target -> "aarch64-linux-gnu") (_ (set-current-target target)) (exp -> (gexp (list (ungexp coreutils)))) - (xdrv (gexp->file "foo" exp)) + (xdrv (gexp->file "foo" exp + #:guile %bootstrap-guile)) (refs (references* (derivation-file-name xdrv))) (xcu (package->cross-derivation coreutils