Subject: Re: [bug#76081] [PATCH v10 5/7] tests: Use lower-oci-image-state in container tests.

From: Maxim Cournoyer <[email-masked]>
Date: Fri, 16 May 2025 10:45:32 +0900

Hi,

Giacomo Leidi <[email-masked]> writes:

> This patch replaces boilerplate in container related tests with
> oci-image plumbing from (gnu services containers).
>
> * gnu/services/containers.scm: Export lower-oci-image-state.

I don't think that's a nice API to export; you can instead use the

(define lower-oci-image-state
  (@@ (gnu services containers) lower-oci-image-state)

trick to expose internals (white box testing).

> * gnu/tests/containers.scm (%oci-tarball): New variable;
> (run-rootless-podman-test): use %oci-tarball;
> (build-tarball&run-rootless-podman-test): drop procedure.
> * gnu/tests/docker.scm (%docker-tarball): New variable;
> (build-tarball&run-docker-test): use %docker-tarball;
> (%docker-system-tarball): New variable;
> (build-tarball&run-docker-system-test): new procedure.
>
> Change-Id: Iad6f0704aee188d89464c83722dea0bb7adb084a
> ---
>  gnu/services/containers.scm |   2 +
>  gnu/tests/containers.scm    |  80 ++++++++++++++---------------
>  gnu/tests/docker.scm        | 100 ++++++++++++++++++++----------------
>  3 files changed, 95 insertions(+), 87 deletions(-)

The diffstats suggest the result is not that impactful in terms of
reducing boilerplate, ah!

> diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm
> index 66b46456800..a8d10d842da 100644
> --- a/gnu/services/containers.scm
> +++ b/gnu/services/containers.scm
> @@ -74,6 +74,8 @@ (define-module (gnu services containers)
>              oci-image-system
>              oci-image-grafts?
>  
> +            lower-oci-image-state
> +
>              oci-container-configuration
>              oci-container-configuration?
>              oci-container-configuration-fields
> diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm
> index 5e6f39387e7..8cdd86e7ae3 100644
> --- a/gnu/tests/containers.scm
> +++ b/gnu/tests/containers.scm
> @@ -69,13 +69,47 @@ (define %rootless-podman-os
>                            (supplementary-groups '("wheel" "netdev" "cgroup"
>                                                    "audio" "video")))))))
>  
> -(define (run-rootless-podman-test oci-tarball)
> +(define %oci-tarball
> +  (lower-oci-image-state
> +   "guile-guest"
> +   (packages->manifest
> +    (list
> +     guile-3.0 guile-json-3
> +     (package
> +       (name "guest-script")
> +       (version "0")
> +       (source #f)
> +       (build-system trivial-build-system)
> +       (arguments `(#:guile ,guile-3.0
> +                    #:builder
> +                    (let ((out (assoc-ref %outputs "out")))

I'd use a gexp for the builder expression here, with gexp variables,
e.g. #$output.

> +                      (mkdir out)
> +                      (call-with-output-file (string-append out "/a.scm")
> +                        (lambda (port)
> +                          (display "(display \"hello world\n\")" port)))
> +                      #t)))

Trailing #t are no longer part of phases/builders in Guix :-).

> +       (synopsis "Display hello world using Guile")
> +       (description "This package displays the text \"hello world\" on the
> +standard output device and then enters a new line.")
> +       (home-page #f)
> +       (license license:public-domain))))
> +   '(#:entry-point "bin/guile"
> +     #:localstatedir? #t
> +     #:extra-options (#:image-tag "guile-guest")
> +     #:symlinks (("/bin/Guile" -> "bin/guile")
> +                 ("aa.scm" -> "a.scm")))
> +   "guile-guest"
> +   (%current-target-system)
> +   (%current-system)
> +   #f))
> +
> +(define (run-rootless-podman-test)
>  
>    (define os
>      (marionette-operating-system
>       (operating-system-with-gc-roots
>        %rootless-podman-os
> -      (list oci-tarball))
> +      (list %oci-tarball))
>       #:imported-modules '((gnu services herd)
>                            (guix combinators))))
>  
> @@ -254,7 +288,7 @@ (define (run-rootless-podman-test oci-tarball)
>                         (let* ((loaded (slurp ,(string-append #$podman
>                                                               "/bin/podman")
>                                               "load" "-i"
> -                                             ,#$oci-tarball))
> +                                             ,#$%oci-tarball))
>                                (repository&tag "localhost/guile-guest:latest")
>                                (response1 (slurp
>                                            ,(string-append #$podman "/bin/podman")
> @@ -307,49 +341,11 @@ (define (run-rootless-podman-test oci-tarball)
>  
>    (gexp->derivation "rootless-podman-test" test))
>  
> -(define (build-tarball&run-rootless-podman-test)
> -  (mlet* %store-monad
> -      ((_ (set-grafting #f))
> -       (guile (set-guile-for-build (default-guile)))
> -       (guest-script-package ->
> -        (package
> -          (name "guest-script")
> -          (version "0")
> -          (source #f)
> -          (build-system trivial-build-system)
> -          (arguments `(#:guile ,guile-3.0
> -                       #:builder
> -                       (let ((out (assoc-ref %outputs "out")))
> -                         (mkdir out)
> -                         (call-with-output-file (string-append out "/a.scm")
> -                           (lambda (port)
> -                             (display "(display \"hello world\n\")" port)))
> -                         #t)))
> -          (synopsis "Display hello world using Guile")
> -          (description "This package displays the text \"hello world\" on the
> -standard output device and then enters a new line.")
> -          (home-page #f)
> -          (license license:public-domain)))
> -       (profile (profile-derivation (packages->manifest
> -                                     (list guile-3.0 guile-json-3
> -                                           guest-script-package))
> -                                    #:hooks '()
> -                                    #:locales? #f))
> -       (tarball (pack:docker-image
> -                 "docker-pack" profile
> -                 #:symlinks '(("/bin/Guile" -> "bin/guile")
> -                              ("aa.scm" -> "a.scm"))
> -                 #:extra-options
> -                 '(#:image-tag "guile-guest")
> -                 #:entry-point "bin/guile"
> -                 #:localstatedir? #t)))
> -    (run-rootless-podman-test tarball)))
> -
>  (define %test-rootless-podman
>    (system-test
>     (name "rootless-podman")
>     (description "Test rootless Podman service.")
> -   (value (build-tarball&run-rootless-podman-test))))
> +   (value (run-rootless-podman-test))))
>  
>  
>  (define %oci-rootless-podman-os
> diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm
> index 5dcf05a17e3..07edd9d5341 100644
> --- a/gnu/tests/docker.scm
> +++ b/gnu/tests/docker.scm
> @@ -26,6 +26,7 @@ (define-module (gnu tests docker)
>    #:use-module (gnu system image)
>    #:use-module (gnu system vm)
>    #:use-module (gnu services)
> +  #:use-module (gnu services containers)
>    #:use-module (gnu services dbus)
>    #:use-module (gnu services networking)
>    #:use-module (gnu services docker)
> @@ -57,6 +58,40 @@ (define %docker-os
>     (service containerd-service-type)
>     (service docker-service-type)))
>  
> +(define %docker-tarball
> +  (lower-oci-image-state
> +   "guile-guest"
> +   (packages->manifest
> +    (list
> +     guile-3.0 guile-json-3
> +     (package
> +       (name "guest-script")
> +       (version "0")
> +       (source #f)
> +       (build-system trivial-build-system)
> +       (arguments `(#:guile ,guile-3.0
> +                    #:builder
> +                    (let ((out (assoc-ref %outputs "out")))
> +                      (mkdir out)
> +                      (call-with-output-file (string-append out "/a.scm")
> +                        (lambda (port)
> +                          (display "(display \"hello world\n\")" port)))
> +                      #t)))

Ditto.

Otherwise LGTM.

-- 
Thanks,
Maxim