summaryrefslogtreecommitdiff
path: root/gnu/tests
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/tests')
-rw-r--r--gnu/tests/containers.scm84
-rw-r--r--gnu/tests/docker.scm104
2 files changed, 87 insertions, 101 deletions
diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm
index 089303643c..1a442cddc6 100644
--- a/gnu/tests/containers.scm
+++ b/gnu/tests/containers.scm
@@ -46,9 +46,6 @@
%test-oci-service-rootless-podman
%test-oci-service-docker))
-(define lower-oci-image-state
- (@@ (gnu services containers) lower-oci-image-state))
-
(define %rootless-podman-os
(simple-operating-system
@@ -72,48 +69,13 @@
(supplementary-groups '("wheel" "netdev" "cgroup"
"audio" "video")))))))
-(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
- (list
- #:guile guile-3.0
- #:builder
- #~(let ((out #$output))
- (mkdir out)
- (call-with-output-file (string-append out "/a.scm")
- (lambda (port)
- (display "(display \"hello world\n\")" port))))))
- (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 (run-rootless-podman-test oci-tarball)
(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))))
@@ -292,7 +254,7 @@ standard output device and then enters a new line.")
(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")
@@ -345,11 +307,49 @@ standard output device and then enters a new line.")
(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 (run-rootless-podman-test))))
+ (value (build-tarball&run-rootless-podman-test))))
(define %oci-network
diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm
index 4fc50a99a7..9fee3905f0 100644
--- a/gnu/tests/docker.scm
+++ b/gnu/tests/docker.scm
@@ -26,7 +26,6 @@
#: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)
@@ -49,9 +48,6 @@
%test-docker-system
%test-oci-container))
-(define lower-oci-image-state
- (@@ (gnu services containers) lower-oci-image-state))
-
(define %docker-os
(simple-operating-system
(service dhcpcd-service-type)
@@ -61,41 +57,6 @@
(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
- (list
- #:guile guile-3.0
- #:builder
- #~(let ((out #$output))
- (mkdir out)
- (call-with-output-file (string-append out "/a.scm")
- (lambda (port)
- (display "(display \"hello world\n\")" port))))))
- (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-docker-test docker-tarball)
"Load DOCKER-TARBALL as Docker image and run it in a Docker container,
inside %DOCKER-OS."
@@ -212,7 +173,40 @@ inside %DOCKER-OS."
(gexp->derivation "docker-test" test))
(define (build-tarball&run-docker-test)
- (run-docker-test %docker-tarball))
+ (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"))
+ #:entry-point "bin/guile"
+ #:localstatedir? #t)))
+ (run-docker-test tarball)))
(define %test-docker
(system-test
@@ -221,22 +215,8 @@ inside %DOCKER-OS."
(value (build-tarball&run-docker-test))))
-(define %docker-system-tarball
- (lower-oci-image-state
- "guix-system-guest"
- (operating-system
- (inherit (simple-operating-system))
- ;; Use locales for a single libc to
- ;; reduce space requirements.
- (locale-libcs (list glibc)))
- '()
- "guix-system-guest"
- (%current-target-system)
- (%current-system)
- #f))
-
(define (run-docker-system-test tarball)
- "Load TARBALL as Docker image and run it in a Docker container,
+ "Load DOCKER-TARBALL as Docker image and run it in a Docker container,
inside %DOCKER-OS."
(define os
(marionette-operating-system
@@ -353,15 +333,21 @@ inside %DOCKER-OS."
(gexp->derivation "docker-system-test" test))
-(define (build-tarball&run-docker-system-test)
- (run-docker-system-test %docker-system-tarball))
-
(define %test-docker-system
(system-test
(name "docker-system")
(description "Run a system image as produced by @command{guix system
docker-image} inside Docker.")
- (value (build-tarball&run-docker-system-test))))
+ (value (with-monad %store-monad
+ (>>= (lower-object
+ (system-image (os->image
+ (operating-system
+ (inherit (simple-operating-system))
+ ;; Use locales for a single libc to
+ ;; reduce space requirements.
+ (locale-libcs (list glibc)))
+ #:type docker-image-type)))
+ run-docker-system-test)))))
(define %oci-os
generated by cgit v1.2.3 (git 2.50.1) at 2025-08-27 16:17:17 +0000