02/03: tests: Pass #:guile to 'computed-file' & co.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit bc1ad69605b6c3e2744694758d63dfc216107a82
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Fri Feb 11 23:17:00 2022 +0100

    tests: Pass #:guile to 'computed-file' & co.
    
    Fixes a regression introduced in
    af57d1bf6c46f47d82dbc234dde1e16fa8634e9d whereby tests would end up
    building the world.
    
    * guix/gexp.scm (mixed-text-file): Add #:guile parameter and honor it.
    * tests/gexp.scm ("mixed-text-file"): Pass #:guile to 'mixed-text-file'.
    ("file-union"): Pass #:guile to 'file-union'.
    ("lower-object, computed-file"): Pass #:guile to 'computed-file'.
    ("lower-object, computed-file + grafts"): Likewise.
    * tests/packages.scm ("origin->derivation, single file with snippet"):
    Likewise.
    * tests/profiles.scm ("profile-derivation, ordering & collisions"):
    Likewise.
    * guix/tests.scm (test-file): Likewise.
---
 guix/gexp.scm      | 13 +++++++------
 guix/tests.scm     |  3 ++-
 tests/gexp.scm     | 12 ++++++++----
 tests/packages.scm |  5 +++--
 tests/profiles.scm |  5 +++--
 5 files changed, 23 insertions(+), 15 deletions(-)

diff --git a/guix/gexp.scm b/guix/gexp.scm
index 8675e605a0..dfeadbd15d 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -2068,7 +2068,7 @@ resulting store file holds references to all these."
                     #:local-build? #t
                     #:substitutable? #f))
 
-(define* (mixed-text-file name #:rest text)
+(define* (mixed-text-file name #:key guile #:rest text)
   "Return an object representing store file NAME containing TEXT.  TEXT is a
 sequence of strings and file-like objects, as in:
 
@@ -2077,12 +2077,13 @@ sequence of strings and file-like objects, as in:
 
 This is the declarative counterpart of 'text-file*'."
   (define build
-    (gexp (call-with-output-file (ungexp output "out")
-            (lambda (port)
-              (set-port-encoding! port "UTF-8")
-              (display (string-append (ungexp-splicing text)) port)))))
+    (let ((text (if guile (drop text 2) text)))
+      (gexp (call-with-output-file (ungexp output "out")
+              (lambda (port)
+                (set-port-encoding! port "UTF-8")
+                (display (string-append (ungexp-splicing text)) port))))))
 
-  (computed-file name build))
+  (computed-file name build #:guile guile))
 
 (define* (file-union name files #:key guile)
   "Return a <computed-file> that builds a directory containing all of FILES.
diff --git a/guix/tests.scm b/guix/tests.scm
index 4cd1ad6cf9..06ef3cf76d 100644
--- a/guix/tests.scm
+++ b/guix/tests.scm
@@ -472,7 +472,8 @@ to its file name extension.  Return both its file name and 
its hash."
                                      (format #t #+content)))
                                  (when #+command
                                    (invoke #+command #+name-sans-ext))
-                                 (copy-file #+name #$output)))))
+                                 (copy-file #+name #$output))
+                             #:guile %bootstrap-guile)))
          (file-drv (run-with-store store (lower-object f)))
          (file (derivation->output-path file-drv))
          (file-drv-outputs (derivation-outputs file-drv))
diff --git a/tests/gexp.scm b/tests/gexp.scm
index ad8e1d57b8..390cf7a207 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014-2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014-2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -1413,6 +1413,7 @@ importing.* \\(guix config\\) from the host"
 
 (test-assertm "mixed-text-file"
   (mlet* %store-monad ((file ->   (mixed-text-file "mixed"
+                                                   #:guile %bootstrap-guile
                                                    "export PATH="
                                                    %bootstrap-guile "/bin"))
                        (drv       (lower-object file))
@@ -1430,7 +1431,8 @@ importing.* \\(guix config\\) from the host"
   (mlet* %store-monad ((union -> (file-union "union"
                                              `(("a" ,(plain-file "a" "1"))
                                                ("b/c/d" ,(plain-file "d" "2"))
-                                               ("e" ,(plain-file "e" "3")))))
+                                               ("e" ,(plain-file "e" "3")))
+                                             #:guile %bootstrap-guile))
                        (drv      (lower-object union))
                        (out ->   (derivation->output-path drv)))
     (define (contents=? file str)
@@ -1469,7 +1471,8 @@ importing.* \\(guix config\\) from the host"
                        (symlink #$%bootstrap-guile
                                 (string-append #$output "/guile"))
                        (symlink #$text (string-append #$output "/text"))))
-         (computed (computed-file "computed" exp)))
+         (computed (computed-file "computed" exp
+                                  #:guile %bootstrap-guile)))
     (mlet* %store-monad ((text      (lower-object text))
                          (guile-drv (lower-object %bootstrap-guile))
                          (comp-drv  (lower-object computed))
@@ -1504,7 +1507,8 @@ importing.* \\(guix config\\) from the host"
                              (display item port))))))
          (computed (computed-file "computed" exp
                                   #:options
-                                  `(#:references-graphs (("graph" ,pkg)))))
+                                  `(#:references-graphs (("graph" ,pkg)))
+                                  #:guile %bootstrap-guile))
          (drv0     (package-derivation %store pkg #:graft? #t))
          (drv1     (parameterize ((%graft? #t))
                      (run-with-store %store
diff --git a/tests/packages.scm b/tests/packages.scm
index 3506f94f91..55b1c4064f 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 
Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012-2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
@@ -716,7 +716,8 @@
                                   (use-modules (guix build utils))
                                   (setenv "PATH" #+bin)
                                   (invoke "tar" "xvf" #+out)
-                                  (copy-file #+name #$output)))))
+                                  (copy-file #+name #$output)))
+                            #:guile %bootstrap-guile))
                         (drv (run-with-store %store (lower-object f)))
                         (_ (build-derivations %store (list drv))))
                    (call-with-input-file (derivation->output-path drv)
diff --git a/tests/profiles.scm b/tests/profiles.scm
index cac5b73347..d59d75985f 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic 
Courtès <ludo@gnu.org>
+;;; Copyright © 2013-2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -302,7 +302,8 @@
                                 (call-with-output-file
                                     (string-append #$output "/bin/guile")
                                   (lambda (port)
-                                    (display "Fake!\n" port))))))))
+                                    (display "Fake!\n" port))))
+                            #:guile %bootstrap-guile))))
        (guile      (package->derivation %bootstrap-guile))
        (drv        (profile-derivation (manifest (list entry1 entry2))
                                        #:hooks '()