amaharaneko/guix-mirrors
1
1
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2025-10-02 02:15:12 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

tests: oci-container: Set explicit timeouts.

Browse source 
* gnu/tests/docker.scm: Simplify %test-oci-container test case and add
explicit timeouts to tests outcomes.

Change-Id: I75868479dcce031f3edc98064b1ebcf975f598f5
Signed-off-by: Maxim Cournoyer <maxim@guixotic.coop>
This commit is contained in:
Giacomo Leidi 2025-08-24 16:59:44 +02:00 • committed by Maxim Cournoyer
parent 0aef9716b6
commit d6200cefcc
No known key found for this signature in database
GPG key ID: 1260E46482E63562
1 changed files with 40 additions and 57 deletions
Download patch file Download diff file Expand all files Collapse all files

97
gnu/tests/docker.scm
View file

@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Danny Milosavljevic <dannym@scratchpost.org> ;;; Copyright © 2019 Danny Milosavljevic <dannym@scratchpost.org>
;;; Copyright © 2019-2023 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2019-2023 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2024 Giacomo Leidi <goodoldpaul@autistici.org> ;;; Copyright © 2024, 2025 Giacomo Leidi <goodoldpaul@autistici.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -414,71 +414,54 @@ docker-image} inside Docker.")
(test-runner-current (system-test-runner #$output)) (test-runner-current (system-test-runner #$output))
(test-begin "oci-container") (test-begin "oci-container")
(test-assert "containerd service running" (wait-for-file "/run/containerd/containerd.pid" marionette)
(marionette-eval
'(begin
(use-modules (gnu services herd))
(match (start-service 'containerd)
(#f #f)
(('service response-parts ...)
(match (assq-ref response-parts 'running)
((pid) pid)))))
marionette))
(test-assert "containerd PID file present"
(wait-for-file "/run/containerd/containerd.pid" marionette))
(test-assert "dockerd running"
(marionette-eval
'(begin
(use-modules (gnu services herd))
(match (start-service 'dockerd)
(#f #f)
(('service response-parts ...)
(match (assq-ref response-parts 'running)
((pid) pid)))))
marionette))
(sleep 10) ; let service start
(test-assert "docker-guile running" (test-assert "docker-guile running"
(marionette-eval (marionette-eval
'(begin '(begin
(use-modules (gnu services herd)) (use-modules (gnu services herd))
(match (start-service 'docker-guile) (wait-for-service 'docker-guile #:timeout 120)
(#f #f) #t)
(('service response-parts ...)
(match (assq-ref response-parts 'running)
((pid) pid)))))
marionette)) marionette))
(test-equal "passing host environment variables and volumes" (test-assert "passing host environment variables and volumes"
'("value" "hello") (begin
(marionette-eval (define (run-test)
`(begin (marionette-eval
(use-modules (ice-9 popen) `(begin
(ice-9 rdelim)) (use-modules (ice-9 popen)
(ice-9 rdelim))
(define slurp (define slurp
(lambda args (lambda args
(let* ((port (apply open-pipe* OPEN_READ args)) (let* ((port (apply open-pipe* OPEN_READ args))
(output (let ((line (read-line port))) (output (let ((line (read-line port)))
(if (eof-object? line) (if (eof-object? line)
"" ""
line))) line)))
(status (close-pipe port))) (status (close-pipe port)))
output))) output)))
(let* ((response1 (slurp (let* ((response1 (slurp
,(string-append #$docker-cli "/bin/docker") ,(string-append #$docker-cli "/bin/docker")
"exec" "docker-guile" "exec" "docker-guile"
"/bin/guile" "-c" "(display (getenv \"VARIABLE\"))")) "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))"))
(response2 (slurp (response2 (slurp
,(string-append #$docker-cli "/bin/docker") ,(string-append #$docker-cli "/bin/docker")
"exec" "docker-guile" "exec" "docker-guile"
"/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim)) "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
(display (call-with-input-file \"/shared.txt\" read-line)))"))) (display (call-with-input-file \"/shared.txt\" read-line)))")))
(list response1 response2))) (list response1 response2)))
marionette)) marionette))
;; Allow services to come up on slower machines
(let loop ((attempts 0))
(if (= attempts 60)
(error "Service didn't come up after more than 60 seconds")
(if (equal? '("value" "hello")
(run-test))
#t
(begin
(sleep 1)
(loop (+ 1 attempts))))))))
(test-end)))) (test-end))))