Package: guix-patches;
Reported by: paul <goodoldpaul <at> autistici.org>
Date: Wed, 5 Feb 2025 22:01:03 UTC
Severity: normal
Tags: moreinfo
View this message in rfc822 format
From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> To: Giacomo Leidi <goodoldpaul <at> autistici.org> Cc: 76081 <at> debbugs.gnu.org Subject: [bug#76081] [PATCH v10 5/7] tests: Use lower-oci-image-state in container tests. Date: Fri, 16 May 2025 10:45:32 +0900
Hi,
Giacomo Leidi <goodoldpaul <at> autistici.org> 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
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.