tests: Skip all the container tests when needed.

Reported by myglc2 <myglc2@gmail.com>
at <http://bugs.gnu.org/23836>.

* tests/containers.scm (skip-if-unsupported): New procedure.
Call it before each test.
This commit is contained in:
Ludovic Courtès 2016-06-25 00:42:19 +02:00
parent 9f25019095
commit 25a3bfbe77
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 13 additions and 4 deletions

View File

@ -30,15 +30,18 @@
;; Skip these tests unless user namespaces are available and the setgroups ;; Skip these tests unless user namespaces are available and the setgroups
;; file (introduced in Linux 3.19 to address a security issue) exists. ;; file (introduced in Linux 3.19 to address a security issue) exists.
(unless (and (user-namespace-supported?) (define (skip-if-unsupported)
(unprivileged-user-namespace-supported?) (unless (and (user-namespace-supported?)
(setgroups-supported?)) (unprivileged-user-namespace-supported?)
(test-skip 7)) (setgroups-supported?))
(test-skip 1)))
(skip-if-unsupported)
(test-assert "call-with-container, exit with 0 when there is no error" (test-assert "call-with-container, exit with 0 when there is no error"
(zero? (zero?
(call-with-container '() (const #t) #:namespaces '(user)))) (call-with-container '() (const #t) #:namespaces '(user))))
(skip-if-unsupported)
(test-assert "call-with-container, user namespace" (test-assert "call-with-container, user namespace"
(zero? (zero?
(call-with-container '() (call-with-container '()
@ -47,6 +50,7 @@
(assert-exit (and (zero? (getuid)) (zero? (getgid))))) (assert-exit (and (zero? (getuid)) (zero? (getgid)))))
#:namespaces '(user)))) #:namespaces '(user))))
(skip-if-unsupported)
(test-assert "call-with-container, uts namespace" (test-assert "call-with-container, uts namespace"
(zero? (zero?
(call-with-container '() (call-with-container '()
@ -57,6 +61,7 @@
(primitive-exit 0)) (primitive-exit 0))
#:namespaces '(user uts)))) #:namespaces '(user uts))))
(skip-if-unsupported)
(test-assert "call-with-container, pid namespace" (test-assert "call-with-container, pid namespace"
(zero? (zero?
(call-with-container '() (call-with-container '()
@ -72,6 +77,7 @@
(status:exit-val status))))))) (status:exit-val status)))))))
#:namespaces '(user pid)))) #:namespaces '(user pid))))
(skip-if-unsupported)
(test-assert "call-with-container, mnt namespace" (test-assert "call-with-container, mnt namespace"
(zero? (zero?
(call-with-container '(("none" device "/testing" "tmpfs" () #f #f)) (call-with-container '(("none" device "/testing" "tmpfs" () #f #f))
@ -79,6 +85,7 @@
(assert-exit (file-exists? "/testing"))) (assert-exit (file-exists? "/testing")))
#:namespaces '(user mnt)))) #:namespaces '(user mnt))))
(skip-if-unsupported)
(test-equal "call-with-container, mnt namespace, wrong bind mount" (test-equal "call-with-container, mnt namespace, wrong bind mount"
`(system-error ,ENOENT) `(system-error ,ENOENT)
;; An exception should be raised; see <http://bugs.gnu.org/23306>. ;; An exception should be raised; see <http://bugs.gnu.org/23306>.
@ -91,12 +98,14 @@
(lambda args (lambda args
(list 'system-error (system-error-errno args))))) (list 'system-error (system-error-errno args)))))
(skip-if-unsupported)
(test-assert "call-with-container, all namespaces" (test-assert "call-with-container, all namespaces"
(zero? (zero?
(call-with-container '() (call-with-container '()
(lambda () (lambda ()
(primitive-exit 0))))) (primitive-exit 0)))))
(skip-if-unsupported)
(test-assert "container-excursion" (test-assert "container-excursion"
(call-with-temporary-directory (call-with-temporary-directory
(lambda (root) (lambda (root)