unofficial mirror of bug-guix@gnu.org 
 help / color / mirror / code / Atom feed
From: Paul Garlick <pgarlick@tourbillion-technology.com>
To: 31977@debbugs.gnu.org
Subject: bug#31977: clone tests fail on CentOS 7
Date: Tue, 26 Jun 2018 15:16:35 +0100	[thread overview]
Message-ID: <1530022595.3353.22.camel@tourbillion-technology.com> (raw)

[-- Attachment #1: Type: text/plain, Size: 971 bytes --]

Hi Guix,

Running 'make check' in the guix source tree on a CentOS 7 system
results in 15 FAILS:

tests/containers.log: 9 FAILS
tests/syscalls.log: 3 FAILS
tests/guix-environment-container.log: 1 FAIL
tests/guix-pack.log: 1 FAIL
tests/pack.log: 1 FAIL

Referring to bug#24108, the cause may be that the clone-related tests
are being executed instead of being skipped. 

The output of 'uname -srv' is:

Linux 3.10.0-862.3.3.el7.x86_64 #1 SMP Fri Jun 15 04:15:27 UTC 2018

Files:
a)  '/proc/self/ns/user' exists
b) '/proc/sys/kernel/unprivileged_userns_clone' does not exist.

On CentOS 7 I believe user namespaces are supported but disabled by
default.  The output of 'cat /proc/sys/user/max_user_namespaces' is
'0'.

Perhaps the 'perform-container-tests?' logic should include an extra
check for the default, disabled case to ensure that the tests are
skipped.

Attached are the log files, except 'guix-pack.log' (~100MB) and
'pack.log' (~7MB).

Best regards,

Paul.


[-- Attachment #2: containers.log --]
[-- Type: text/x-log, Size: 8008 bytes --]

test-name: call-with-container, exit with 0 when there is no error
location: /data/paul/sourceCode/guix/tests/containers.scm:41
source:
+ (test-assert
+   "call-with-container, exit with 0 when there is no error"
+   (zero? (call-with-container
+            '()
+            (const #t)
+            #:namespaces
+            '(user))))
actual-value: #f
actual-error:
+ (system-error
+   "clone"
+   "~d: ~A"
+   (268435473 "Invalid argument")
+   (22))
result: FAIL

test-name: call-with-container, user namespace
location: /data/paul/sourceCode/guix/tests/containers.scm:46
source:
+ (test-assert
+   "call-with-container, user namespace"
+   (zero? (call-with-container
+            '()
+            (lambda ()
+              (assert-exit
+                (and (zero? (getuid)) (zero? (getgid)))))
+            #:namespaces
+            '(user))))
actual-value: #f
actual-error:
+ (system-error
+   "clone"
+   "~d: ~A"
+   (268435473 "Invalid argument")
+   (22))
result: FAIL

test-name: call-with-container, uts namespace
location: /data/paul/sourceCode/guix/tests/containers.scm:55
source:
+ (test-assert
+   "call-with-container, uts namespace"
+   (zero? (call-with-container
+            '()
+            (lambda ()
+              (sethostname "test-container")
+              (primitive-exit 0))
+            #:namespaces
+            '(user uts))))
actual-value: #f
actual-error:
+ (system-error
+   "clone"
+   "~d: ~A"
+   (335544337 "Invalid argument")
+   (22))
result: FAIL

test-name: call-with-container, pid namespace
location: /data/paul/sourceCode/guix/tests/containers.scm:66
source:
+ (test-assert
+   "call-with-container, pid namespace"
+   (zero? (call-with-container
+            '()
+            (lambda ()
+              (match (primitive-fork)
+                     (0 (assert-exit (= 2 (getpid))))
+                     (pid (primitive-exit
+                            (match (waitpid pid)
+                                   ((_ . status)
+                                    (status:exit-val status)))))))
+            #:namespaces
+            '(user pid))))
actual-value: #f
actual-error:
+ (system-error
+   "clone"
+   "~d: ~A"
+   (805306385 "Invalid argument")
+   (22))
result: FAIL

test-name: call-with-container, mnt namespace
location: /data/paul/sourceCode/guix/tests/containers.scm:82
source:
+ (test-assert
+   "call-with-container, mnt namespace"
+   (zero? (call-with-container
+            (list (file-system
+                    (device "none")
+                    (mount-point "/testing")
+                    (type "tmpfs")
+                    (check? #f)))
+            (lambda ()
+              (assert-exit (file-exists? "/testing")))
+            #:namespaces
+            '(user mnt))))
actual-value: #f
actual-error:
+ (system-error
+   "clone"
+   "~d: ~A"
+   (268566545 "Invalid argument")
+   (22))
result: FAIL

test-name: call-with-container, mnt namespace, wrong bind mount
location: /data/paul/sourceCode/guix/tests/containers.scm:94
source:
+ (test-equal
+   "call-with-container, mnt namespace, wrong bind mount"
+   `(system-error ,ENOENT)
+   (catch 'system-error
+          (lambda ()
+            (call-with-container
+              (list (file-system
+                      (device "/does-not-exist")
+                      (mount-point "/foo")
+                      (type "none")
+                      (flags '(bind-mount))
+                      (check? #f)))
+              (const #t)
+              #:namespaces
+              '(user mnt)))
+          (lambda args
+            (list 'system-error (system-error-errno args)))))
expected-value: (system-error 2)
actual-value: (system-error 22)
result: FAIL

test-name: call-with-container, all namespaces
location: /data/paul/sourceCode/guix/tests/containers.scm:111
source:
+ (test-assert
+   "call-with-container, all namespaces"
+   (zero? (call-with-container
+            '()
+            (lambda () (primitive-exit 0)))))
actual-value: #f
actual-error:
+ (system-error
+   "clone"
+   "~d: ~A"
+   (2080505873 "Invalid argument")
+   (22))
result: FAIL

test-name: container-excursion
location: /data/paul/sourceCode/guix/tests/containers.scm:118
source:
+ (test-assert
+   "container-excursion"
+   (call-with-temporary-directory
+     (lambda (root)
+       (match (list (pipe) (pipe))
+              (((start-in . start-out) (end-in . end-out))
+               (define (container)
+                 (close end-out)
+                 (close start-in)
+                 (write 'ready start-out)
+                 (close start-out)
+                 (read end-in)
+                 (close end-in))
+               (define (namespaces pid)
+                 (let ((pid (number->string pid)))
+                   (map (lambda (ns)
+                          (readlink (string-append "/proc/" pid "/ns/" ns)))
+                        '("user" "ipc" "uts" "net" "pid" "mnt"))))
+               (let* ((pid (run-container root '() %namespaces 1 container))
+                      (container-namespaces (namespaces pid))
+                      (result
+                        (begin
+                          (close start-out)
+                          (read start-in)
+                          (close start-in)
+                          (container-excursion
+                            pid
+                            (lambda ()
+                              (match (primitive-fork)
+                                     (0
+                                      (assert-exit
+                                        (equal?
+                                          container-namespaces
+                                          (namespaces (getpid)))))
+                                     (fork-pid
+                                       (match (waitpid fork-pid)
+                                              ((_ . status)
+                                               (primitive-exit
+                                                 (status:exit-val
+                                                   status)))))))))))
+                 (close end-in)
+                 (write 'done end-out)
+                 (close end-out)
+                 (waitpid pid)
+                 (zero? result)))))))
actual-value: #f
actual-error:
+ (system-error
+   "clone"
+   "~d: ~A"
+   (2080505873 "Invalid argument")
+   (22))
result: FAIL

test-name: container-excursion, same namespaces
location: /data/paul/sourceCode/guix/tests/containers.scm:175
source:
+ (test-equal
+   "container-excursion, same namespaces"
+   42
+   (container-excursion
+     (getpid)
+     (lambda () (primitive-exit 42))))
expected-value: 42
actual-value: 42
result: PASS

test-name: container-excursion*
location: /data/paul/sourceCode/guix/tests/containers.scm:184
source:
+ (test-assert
+   "container-excursion*"
+   (call-with-temporary-directory
+     (lambda (root)
+       (define (namespaces pid)
+         (let ((pid (number->string pid)))
+           (map (lambda (ns)
+                  (readlink (string-append "/proc/" pid "/ns/" ns)))
+                '("user" "ipc" "uts" "net" "pid" "mnt"))))
+       (let* ((pid (run-container
+                     root
+                     '()
+                     %namespaces
+                     1
+                     (lambda () (sleep 100))))
+              (expected (namespaces pid))
+              (result
+                (container-excursion*
+                  pid
+                  (lambda () (namespaces 1)))))
+         (kill pid SIGKILL)
+         (equal? result expected)))))
actual-value: #f
actual-error:
+ (system-error
+   "clone"
+   "~d: ~A"
+   (2080505873 "Invalid argument")
+   (22))
result: FAIL

test-name: container-excursion*, same namespaces
location: /data/paul/sourceCode/guix/tests/containers.scm:205
source:
+ (test-equal
+   "container-excursion*, same namespaces"
+   42
+   (container-excursion*
+     (getpid)
+     (lambda () (* 6 7))))
expected-value: 42
actual-value: 42
result: PASS


[-- Attachment #3: guix-environment-container.log --]
[-- Type: text/x-log, Size: 1032 bytes --]

accepted connection from pid 1029, user paul
+ set -e
+ guix environment --version
guix environment (GNU Guix) 0.14.0.6752-a87cb
Copyright (C) 2018 the Guix authors
License GPLv3+: GNU GPL version 3 or later <http://gnu.org/licenses/gpl.html>
This is free software: you are free to change and redistribute it.
There is NO WARRANTY, to the extent permitted by law.
+ guile -c '((@@ (guix scripts environment) assert-container-features))'
+ tmpdir=t-guix-environment-1039
+ trap 'rm -r "$tmpdir"' EXIT
+ mkdir t-guix-environment-1039
+ guix environment --container --ad-hoc --bootstrap guile-bootstrap -- guile -c '(exit 42)'
accepted connection from pid 1054, user paul
guix environment: error: clone: 2080505873: Invalid argument
+ test 1 = 42
+ rm -r t-guix-environment-1039
./test-env: line 1:  1028 Terminated              "/data/paul/sourceCode/guix/pre-inst-env" "/data/paul/sourceCode/guix/guix-daemon" --disable-chroot --substitute-urls="$GUIX_BINARY_SUBSTITUTE_URL"
FAIL tests/guix-environment-container.sh (exit status: 1)

[-- Attachment #4: syscalls.log --]
[-- Type: text/x-log, Size: 27345 bytes --]

test-name: mount, ENOENT
location: /data/paul/sourceCode/guix/tests/syscalls.scm:40
source:
+ (test-equal
+   "mount, ENOENT"
+   ENOENT
+   (catch 'system-error
+          (lambda ()
+            (mount "/dev/null" "/does-not-exist" "ext2")
+            #f)
+          (compose system-error-errno list)))
expected-value: 2
actual-value: 2
result: PASS

test-name: umount, ENOENT/EPERM
location: /data/paul/sourceCode/guix/tests/syscalls.scm:48
source:
+ (test-assert
+   "umount, ENOENT/EPERM"
+   (catch 'system-error
+          (lambda () (umount "/does-not-exist") #f)
+          (lambda args
+            (memv (system-error-errno args)
+                  (list EPERM ENOENT)))))
actual-value: (1 2)
result: PASS

test-name: mount-points
location: /data/paul/sourceCode/guix/tests/syscalls.scm:57
source:
+ (test-assert
+   "mount-points"
+   (any (cute member <> (mount-points))
+        '("/" "/proc" "/sys" "/dev")))
actual-value: ("/" "/sys" "/proc" "/dev" "/sys/kernel/security" "/dev/shm" "/dev/pts" "/run" "/sys/fs/cgroup" "/sys/fs/cgroup/systemd" "/sys/fs/pstore" "/sys/firmware/efi/efivars" "/sys/fs/cgroup/pids" "/sys/fs/cgroup/cpuset" "/sys/fs/cgroup/freezer" "/sys/fs/cgroup/hugetlb" "/sys/fs/cgroup/perf_event" "/sys/fs/cgroup/net_cls,net_prio" "/sys/fs/cgroup/cpu,cpuacct" "/sys/fs/cgroup/memory" "/sys/fs/cgroup/devices" "/sys/fs/cgroup/blkio" "/sys/kernel/config" "/" "/sys/fs/selinux" "/proc/sys/fs/binfmt_misc" "/dev/hugepages" "/dev/mqueue" "/sys/kernel/debug" "/proc/fs/nfsd" "/boot" "/data" "/home" "/boot/efi" "/var/lib/nfs/rpc_pipefs" "/run/user/1000")
result: PASS

test-name: swapon, ENOENT/EPERM
location: /data/paul/sourceCode/guix/tests/syscalls.scm:63
source:
+ (test-assert
+   "swapon, ENOENT/EPERM"
+   (catch 'system-error
+          (lambda () (swapon "/does-not-exist") #f)
+          (lambda args
+            (memv (system-error-errno args)
+                  (list EPERM ENOENT)))))
actual-value: (1 2)
result: PASS

test-name: swapoff, ENOENT/EINVAL/EPERM
location: /data/paul/sourceCode/guix/tests/syscalls.scm:71
source:
+ (test-assert
+   "swapoff, ENOENT/EINVAL/EPERM"
+   (catch 'system-error
+          (lambda () (swapoff "/does-not-exist") #f)
+          (lambda args
+            (memv (system-error-errno args)
+                  (list EPERM EINVAL ENOENT)))))
actual-value: (1 22 2)
result: PASS

test-name: mkdtemp!
location: /data/paul/sourceCode/guix/tests/syscalls.scm:79
source:
+ (test-assert
+   "mkdtemp!"
+   (let* ((tmp (or (getenv "TMPDIR") "/tmp"))
+          (dir (mkdtemp!
+                 (string-append tmp "/guix-test-XXXXXX"))))
+     (and (file-exists? dir) (begin (rmdir dir) #t))))
actual-value: #t
result: PASS

test-name: statfs, ENOENT
location: /data/paul/sourceCode/guix/tests/syscalls.scm:87
source:
+ (test-equal
+   "statfs, ENOENT"
+   ENOENT
+   (catch 'system-error
+          (lambda () (statfs "/does-not-exist"))
+          (compose system-error-errno list)))
expected-value: 2
actual-value: 2
result: PASS

test-name: statfs
location: /data/paul/sourceCode/guix/tests/syscalls.scm:94
source:
+ (test-assert
+   "statfs"
+   (let ((fs (statfs "/")))
+     (and (file-system? fs)
+          (> (file-system-block-size fs) 0)
+          (>= (file-system-blocks-available fs) 0)
+          (>= (file-system-blocks-free fs)
+              (file-system-blocks-available fs)))))
actual-value: #t
result: PASS

test-name: clone
location: /data/paul/sourceCode/guix/tests/syscalls.scm:111
source:
+ (test-assert
+   "clone"
+   (match (clone (logior CLONE_NEWUSER SIGCHLD))
+          (0 (primitive-exit 42))
+          (pid (and (not (equal?
+                           (readlink (user-namespace pid))
+                           (readlink (user-namespace (getpid)))))
+                    (match (waitpid pid)
+                           ((_ . status) (= 42 (status:exit-val status))))))))
actual-value: #f
actual-error:
+ (system-error
+   "clone"
+   "~d: ~A"
+   (268435473 "Invalid argument")
+   (22))
result: FAIL

test-name: setns
location: /data/paul/sourceCode/guix/tests/syscalls.scm:124
source:
+ (test-assert
+   "setns"
+   (match (clone (logior CLONE_NEWUSER SIGCHLD))
+          (0 (primitive-exit 0))
+          (clone-pid
+            (match (pipe)
+                   ((in . out)
+                    (match (primitive-fork)
+                           (0
+                            (close in)
+                            (call-with-input-file
+                              (user-namespace clone-pid)
+                              (lambda (port) (setns (port->fdes port) 0)))
+                            (write 'done out)
+                            (close out)
+                            (primitive-exit 0))
+                           (fork-pid
+                             (close out)
+                             (read in)
+                             (let ((result
+                                     (and (equal?
+                                            (readlink
+                                              (user-namespace clone-pid))
+                                            (readlink
+                                              (user-namespace fork-pid))))))
+                               (waitpid clone-pid)
+                               (waitpid fork-pid)
+                               result))))))))
actual-value: #f
actual-error:
+ (system-error
+   "clone"
+   "~d: ~A"
+   (268435473 "Invalid argument")
+   (22))
result: FAIL

test-name: pivot-root
location: /data/paul/sourceCode/guix/tests/syscalls.scm:162
source:
+ (test-equal
+   "pivot-root"
+   #t
+   (match (pipe)
+          ((in . out)
+           (match (clone (logior CLONE_NEWUSER CLONE_NEWNS SIGCHLD))
+                  (0
+                   (dynamic-wind
+                     (const #t)
+                     (lambda ()
+                       (close in)
+                       (call-with-temporary-directory
+                         (lambda (root)
+                           (let ((put-old (string-append root "/real-root")))
+                             (mount "none" root "tmpfs")
+                             (mkdir put-old)
+                             (call-with-output-file
+                               (string-append root "/test")
+                               (lambda (port) (display "testing\n" port)))
+                             (pivot-root root put-old)
+                             (write (file-exists? "/test") out)
+                             (close out)))))
+                     (lambda () (primitive-exit 0))))
+                  (pid (close out)
+                       (let ((result (read in)))
+                         (close in)
+                         (and (zero? (match (waitpid pid)
+                                            ((_ . status)
+                                             (status:exit-val status))))
+                              (eq? #t result))))))))
expected-value: #t
actual-value: #f
actual-error:
+ (system-error
+   "clone"
+   "~d: ~A"
+   (268566545 "Invalid argument")
+   (22))
result: FAIL

test-name: scandir*, ENOENT
location: /data/paul/sourceCode/guix/tests/syscalls.scm:195
source:
+ (test-equal
+   "scandir*, ENOENT"
+   ENOENT
+   (catch 'system-error
+          (lambda () (scandir* "/does/not/exist"))
+          (lambda args (system-error-errno args))))
expected-value: 2
actual-value: 2
result: PASS

test-name: scandir*, ASCII file names
location: /data/paul/sourceCode/guix/tests/syscalls.scm:203
source:
+ (test-equal
+   "scandir*, ASCII file names"
+   (scandir
+     (dirname
+       (search-path %load-path "guix/base32.scm"))
+     (const #t)
+     string<?)
+   (match (scandir*
+            (dirname
+              (search-path %load-path "guix/base32.scm")))
+          (((names . properties) ...) names)))
expected-value: ("." ".." "base16.go" "base16.scm" "base32.go" "base32.scm" "base64.go" "base64.scm" "build" "build-system" "build-system.go" "build-system.scm" "cache.go" "cache.scm" "ci.go" "ci.scm" "combinators.go" "combinators.scm" "config.go" "config.scm" "config.scm.in" "cpio.go" "cpio.scm" "cve.go" "cve.scm" "cvs-download.go" "cvs-download.scm" "derivations.go" "derivations.scm" "discovery.go" "discovery.scm" "docker.go" "docker.scm" "download.go" "download.scm" "elf.go" "elf.scm" "ftp-client.go" "ftp-client.scm" "gcrypt.go" "gcrypt.scm" "gexp.go" "gexp.scm" "git-download.go" "git-download.scm" "git.go" "git.scm" "glob.go" "glob.scm" "gnu-maintenance.go" "gnu-maintenance.scm" "gnupg.go" "gnupg.scm" "grafts.go" "grafts.scm" "graph.go" "graph.scm" "hash.go" "hash.scm" "hg-download.go" "hg-download.scm" "http-client.go" "http-client.scm" "i18n.go" "i18n.scm" "import" "licenses.go" "licenses.scm" "man-db.scm" "memoization.go" "memoization.scm" "modules.go" "modules.scm" "monad-repl.go" "monad-repl.scm" "monads.go" "monads.scm" "nar.go" "nar.scm" "packages.go" "packages.scm" "pk-crypto.go" "pk-crypto.scm" "pki.go" "pki.scm" "profiles.go" "profiles.scm" "profiling.go" "profiling.scm" "progress.go" "progress.scm" "records.go" "records.scm" "scripts" "scripts.go" "scripts.scm" "search-paths.go" "search-paths.scm" "self.go" "self.scm" "serialization.go" "serialization.scm" "sets.go" "sets.scm" "ssh.go" "ssh.scm" "store" "store.go" "store.scm" "svn-download.go" "svn-download.scm" "tests" "tests.go" "tests.scm" "ui.go" "ui.scm" "upstream.go" "upstream.scm" "utils.go" "utils.scm" "workers.go" "workers.scm" "zlib.go" "zlib.scm")
actual-value: ("." ".." "base16.go" "base16.scm" "base32.go" "base32.scm" "base64.go" "base64.scm" "build" "build-system" "build-system.go" "build-system.scm" "cache.go" "cache.scm" "ci.go" "ci.scm" "combinators.go" "combinators.scm" "config.go" "config.scm" "config.scm.in" "cpio.go" "cpio.scm" "cve.go" "cve.scm" "cvs-download.go" "cvs-download.scm" "derivations.go" "derivations.scm" "discovery.go" "discovery.scm" "docker.go" "docker.scm" "download.go" "download.scm" "elf.go" "elf.scm" "ftp-client.go" "ftp-client.scm" "gcrypt.go" "gcrypt.scm" "gexp.go" "gexp.scm" "git-download.go" "git-download.scm" "git.go" "git.scm" "glob.go" "glob.scm" "gnu-maintenance.go" "gnu-maintenance.scm" "gnupg.go" "gnupg.scm" "grafts.go" "grafts.scm" "graph.go" "graph.scm" "hash.go" "hash.scm" "hg-download.go" "hg-download.scm" "http-client.go" "http-client.scm" "i18n.go" "i18n.scm" "import" "licenses.go" "licenses.scm" "man-db.scm" "memoization.go" "memoization.scm" "modules.go" "modules.scm" "monad-repl.go" "monad-repl.scm" "monads.go" "monads.scm" "nar.go" "nar.scm" "packages.go" "packages.scm" "pk-crypto.go" "pk-crypto.scm" "pki.go" "pki.scm" "profiles.go" "profiles.scm" "profiling.go" "profiling.scm" "progress.go" "progress.scm" "records.go" "records.scm" "scripts" "scripts.go" "scripts.scm" "search-paths.go" "search-paths.scm" "self.go" "self.scm" "serialization.go" "serialization.scm" "sets.go" "sets.scm" "ssh.go" "ssh.scm" "store" "store.go" "store.scm" "svn-download.go" "svn-download.scm" "tests" "tests.go" "tests.scm" "ui.go" "ui.scm" "upstream.go" "upstream.scm" "utils.go" "utils.scm" "workers.go" "workers.scm" "zlib.go" "zlib.scm")
result: PASS

test-name: scandir*, UTF-8 file names
location: /data/paul/sourceCode/guix/tests/syscalls.scm:210
source:
+ (test-equal
+   "scandir*, UTF-8 file names"
+   '("." ".." "?" "?")
+   (call-with-temporary-directory
+     (lambda (directory)
+       (let ((creat (pointer->procedure
+                      int
+                      (dynamic-func "creat" (dynamic-link))
+                      (list '* int))))
+         (creat (string->pointer
+                  (string-append directory "/?")
+                  "UTF-8")
+                420)
+         (creat (string->pointer
+                  (string-append directory "/?")
+                  "UTF-8")
+                420)
+         (let ((locale (setlocale LC_ALL)))
+           (dynamic-wind
+             (lambda () (setlocale LC_ALL "C"))
+             (lambda ()
+               (match (scandir* directory)
+                      (((names . properties) ...) names)))
+             (lambda () (setlocale LC_ALL locale))))))))
expected-value: ("." ".." "?" "?")
actual-value: ("." ".." "?" "?")
result: PASS

test-name: scandir*, properties
location: /data/paul/sourceCode/guix/tests/syscalls.scm:237
source:
+ (test-assert
+   "scandir*, properties"
+   (let ((directory
+           (dirname
+             (search-path %load-path "guix/base32.scm"))))
+     (every (lambda (entry name)
+              (match entry
+                     ((name2 . properties)
+                      (and (string=? name2 name)
+                           (let* ((full (string-append directory "/" name))
+                                  (stat (lstat full))
+                                  (inode (assoc-ref properties 'inode))
+                                  (type (assoc-ref properties 'type)))
+                             (and (= inode (stat:ino stat))
+                                  (or (eq? type 'unknown)
+                                      (eq? type (stat:type stat)))))))))
+            (scandir* directory)
+            (scandir directory (const #t) string<?))))
actual-value: #t
result: PASS

test-name: fcntl-flock wait
location: /data/paul/sourceCode/guix/tests/syscalls.scm:254
source:
+ (test-equal
+   "fcntl-flock wait"
+   42
+   (let ((file (open-file temp-file "w0b")))
+     (fcntl-flock file 'write-lock)
+     (match (primitive-fork)
+            (0
+             (dynamic-wind
+               (const #t)
+               (lambda ()
+                 (let ((file (open-file temp-file "r0b")))
+                   (fcntl-flock file 'read-lock)
+                   (primitive-exit (read file)))
+                 (primitive-exit 1))
+               (lambda () (primitive-exit 2))))
+            (pid (display "hello, world!" file)
+                 (force-output file)
+                 (sleep 1)
+                 (seek file 0 SEEK_SET)
+                 (truncate-file file 0)
+                 (write 42 file)
+                 (force-output file)
+                 (fcntl-flock file 'unlock)
+                 (match (waitpid pid)
+                        ((_ . status)
+                         (let ((result (status:exit-val status)))
+                           (close-port file)
+                           result)))))))
expected-value: 42
actual-value: 42
result: PASS

test-name: fcntl-flock non-blocking
location: /data/paul/sourceCode/guix/tests/syscalls.scm:293
source:
+ (test-equal
+   "fcntl-flock non-blocking"
+   EAGAIN
+   (match (pipe)
+          ((input . output)
+           (match (primitive-fork)
+                  (0
+                   (dynamic-wind
+                     (const #t)
+                     (lambda ()
+                       (close-port output)
+                       (read-char input)
+                       (let ((file (open-file temp-file "w0")))
+                         (catch 'flock-error
+                                (lambda ()
+                                  (fcntl-flock file 'write-lock #:wait? #f))
+                                (lambda (key errno)
+                                  (primitive-exit (pk 'errno errno)))))
+                       (primitive-exit -1))
+                     (lambda () (primitive-exit -2))))
+                  (pid (close-port input)
+                       (let ((file (open-file temp-file "w0")))
+                         (fcntl-flock file 'write-lock)
+                         (write 'green-light output)
+                         (force-output output)
+                         (match (waitpid pid)
+                                ((_ . status)
+                                 (let ((result (status:exit-val status)))
+                                   (fcntl-flock file 'unlock)
+                                   (close-port file)
+                                   result)))))))))

;;; (errno 11)
expected-value: 11
actual-value: 11
result: PASS

test-name: set-thread-name
location: /data/paul/sourceCode/guix/tests/syscalls.scm:335
source:
+ (test-equal
+   "set-thread-name"
+   "Syscall Test"
+   (let ((name (thread-name)))
+     (set-thread-name "Syscall Test")
+     (let ((new-name (thread-name)))
+       (set-thread-name name)
+       new-name)))
expected-value: "Syscall Test"
actual-value: "Syscall Test"
result: PASS

test-name: all-network-interface-names
location: /data/paul/sourceCode/guix/tests/syscalls.scm:343
source:
+ (test-assert
+   "all-network-interface-names"
+   (match (all-network-interface-names)
+          (((? string? names) ..1) (member "lo" names))))
actual-value: ("lo")
result: PASS

test-name: network-interface-names
location: /data/paul/sourceCode/guix/tests/syscalls.scm:348
source:
+ (test-assert
+   "network-interface-names"
+   (match (network-interface-names)
+          (((? string? names) ..1)
+           (lset<=
+             string=?
+             names
+             (all-network-interface-names)))))
actual-value: #t
result: PASS

test-name: network-interface-flags
location: /data/paul/sourceCode/guix/tests/syscalls.scm:353
source:
+ (test-assert
+   "network-interface-flags"
+   (let* ((sock (socket AF_INET SOCK_STREAM 0))
+          (flags (network-interface-flags sock "lo")))
+     (close-port sock)
+     (and (not (zero? (logand flags IFF_LOOPBACK)))
+          (not (zero? (logand flags IFF_UP))))))
actual-value: #t
result: PASS

test-name: loopback-network-interface?
location: /data/paul/sourceCode/guix/tests/syscalls.scm:360
source:
+ (test-equal
+   "loopback-network-interface?"
+   ENODEV
+   (and (loopback-network-interface? "lo")
+        (catch 'system-error
+               (lambda ()
+                 (loopback-network-interface? "nonexistent")
+                 #f)
+               (lambda args (system-error-errno args)))))
expected-value: 19
actual-value: 19
result: PASS

test-name: loopback-network-interface-running?
location: /data/paul/sourceCode/guix/tests/syscalls.scm:370
source:
+ (test-equal
+   "loopback-network-interface-running?"
+   ENODEV
+   (and (network-interface-running? "lo")
+        (catch 'system-error
+               (lambda ()
+                 (network-interface-running? "nonexistent")
+                 #f)
+               (lambda args (system-error-errno args)))))
expected-value: 19
actual-value: 19
result: PASS

test-name: set-network-interface-flags
location: /data/paul/sourceCode/guix/tests/syscalls.scm:381
source:
+ (test-assert
+   "set-network-interface-flags"
+   (let ((sock (socket AF_INET SOCK_STREAM 0)))
+     (catch 'system-error
+            (lambda ()
+              (set-network-interface-flags sock "lo" IFF_UP))
+            (lambda args
+              (close-port sock)
+              (memv (system-error-errno args)
+                    (list EPERM EACCES))))))
actual-value: (1 13)
result: PASS

test-name: network-interface-address lo
location: /data/paul/sourceCode/guix/tests/syscalls.scm:391
source:
+ (test-equal
+   "network-interface-address lo"
+   (make-socket-address
+     AF_INET
+     (inet-pton AF_INET "127.0.0.1")
+     0)
+   (let* ((sock (socket AF_INET SOCK_STREAM 0))
+          (addr (network-interface-address sock "lo")))
+     (close-port sock)
+     addr))
expected-value: #(2 2130706433 0)
actual-value: #(2 2130706433 0)
result: PASS

test-name: set-network-interface-address
location: /data/paul/sourceCode/guix/tests/syscalls.scm:399
source:
+ (test-assert
+   "set-network-interface-address"
+   (let ((sock (socket AF_INET SOCK_STREAM 0)))
+     (catch 'system-error
+            (lambda ()
+              (set-network-interface-address
+                sock
+                "nonexistent"
+                (make-socket-address
+                  AF_INET
+                  (inet-pton AF_INET "127.12.14.15")
+                  0)))
+            (lambda args
+              (close-port sock)
+              (memv (system-error-errno args)
+                    (list EPERM EACCES))))))
actual-value: (1 13)
result: PASS

test-name: network-interface-netmask lo
location: /data/paul/sourceCode/guix/tests/syscalls.scm:413
source:
+ (test-equal
+   "network-interface-netmask lo"
+   (make-socket-address
+     AF_INET
+     (inet-pton AF_INET "255.0.0.0")
+     0)
+   (let* ((sock (socket AF_INET SOCK_STREAM 0))
+          (addr (network-interface-netmask sock "lo")))
+     (close-port sock)
+     addr))
expected-value: #(2 4278190080 0)
actual-value: #(2 4278190080 0)
result: PASS

test-name: set-network-interface-netmask
location: /data/paul/sourceCode/guix/tests/syscalls.scm:421
source:
+ (test-assert
+   "set-network-interface-netmask"
+   (let ((sock (socket AF_INET SOCK_STREAM 0)))
+     (catch 'system-error
+            (lambda ()
+              (set-network-interface-netmask
+                sock
+                "nonexistent"
+                (make-socket-address
+                  AF_INET
+                  (inet-pton AF_INET "255.0.0.0")
+                  0)))
+            (lambda args
+              (close-port sock)
+              (memv (system-error-errno args)
+                    (list EPERM EACCES))))))
actual-value: (1 13)
result: PASS

test-name: network-interfaces returns one or more interfaces
location: /data/paul/sourceCode/guix/tests/syscalls.scm:434
source:
+ (test-equal
+   "network-interfaces returns one or more interfaces"
+   '(#t #t #t)
+   (match (network-interfaces)
+          ((interfaces ..1)
+           (list (every interface? interfaces)
+                 (every string? (map interface-name interfaces))
+                 (every (lambda (sockaddr)
+                          (or (vector? sockaddr) (not sockaddr)))
+                        (map interface-address interfaces))))))
expected-value: (#t #t #t)
actual-value: (#t #t #t)
result: PASS

test-name: network-interfaces returns "lo"
location: /data/paul/sourceCode/guix/tests/syscalls.scm:446
source:
+ (test-equal
+   "network-interfaces returns \"lo\""
+   (list #t
+         (make-socket-address
+           AF_INET
+           (inet-pton AF_INET "127.0.0.1")
+           0))
+   (match (filter
+            (lambda (interface)
+              (string=? "lo" (interface-name interface)))
+            (network-interfaces))
+          ((loopbacks ..1)
+           (list (every (lambda (lo)
+                          (not (zero? (logand
+                                        IFF_LOOPBACK
+                                        (interface-flags lo)))))
+                        loopbacks)
+                 (match (find (lambda (lo)
+                                (= AF_INET
+                                   (sockaddr:fam (interface-address lo))))
+                              loopbacks)
+                        (#f #f)
+                        (lo (interface-address lo)))))))
expected-value: (#t #(2 2130706433 0))
actual-value: (#t #(2 2130706433 0))
result: PASS

test-name: add-network-route/gateway
location: /data/paul/sourceCode/guix/tests/syscalls.scm:462
source:
+ (test-assert
+   "add-network-route/gateway"
+   (let ((sock (socket AF_INET SOCK_STREAM 0))
+         (gateway
+           (make-socket-address
+             AF_INET
+             (inet-pton AF_INET "192.168.0.1")
+             0)))
+     (catch 'system-error
+            (lambda ()
+              (add-network-route/gateway sock gateway))
+            (lambda args
+              (close-port sock)
+              (memv (system-error-errno args)
+                    (list EPERM EACCES))))))
actual-value: (1 13)
result: PASS

test-name: delete-network-route
location: /data/paul/sourceCode/guix/tests/syscalls.scm:475
source:
+ (test-assert
+   "delete-network-route"
+   (let ((sock (socket AF_INET SOCK_STREAM 0))
+         (destination
+           (make-socket-address AF_INET INADDR_ANY 0)))
+     (catch 'system-error
+            (lambda ()
+              (delete-network-route sock destination))
+            (lambda args
+              (close-port sock)
+              (memv (system-error-errno args)
+                    (list EPERM EACCES))))))
actual-value: (1 13)
result: PASS

test-name: tcgetattr ENOTTY
location: /data/paul/sourceCode/guix/tests/syscalls.scm:485
source:
+ (test-equal
+   "tcgetattr ENOTTY"
+   ENOTTY
+   (catch 'system-error
+          (lambda ()
+            (call-with-input-file
+              "/dev/null"
+              (lambda (port) (tcgetattr (fileno port)))))
+          (compose system-error-errno list)))
expected-value: 25
actual-value: 25
result: PASS

test-name: tcgetattr
location: /data/paul/sourceCode/guix/tests/syscalls.scm:499
source:
+ (test-assert
+   "tcgetattr"
+   (let ((termios (tcgetattr 0)))
+     (and (termios? termios)
+          (> (termios-input-speed termios) 0)
+          (> (termios-output-speed termios) 0))))
actual-value: #t
result: PASS

test-name: tcsetattr
location: /data/paul/sourceCode/guix/tests/syscalls.scm:505
source:
+ (test-assert
+   "tcsetattr"
+   (let ((first (tcgetattr 0)))
+     (tcsetattr 0 (tcsetattr-action TCSANOW) first)
+     (equal? first (tcgetattr 0))))
actual-value: #t
result: PASS

test-name: terminal-window-size ENOTTY
location: /data/paul/sourceCode/guix/tests/syscalls.scm:510
source:
+ (test-assert
+   "terminal-window-size ENOTTY"
+   (call-with-input-file
+     "/dev/null"
+     (lambda (port)
+       (catch 'system-error
+              (lambda () (terminal-window-size port))
+              (lambda args
+                (memv (system-error-errno args)
+                      (list ENOTTY EINVAL)))))))
actual-value: (25 22)
result: PASS

test-name: terminal-columns
location: /data/paul/sourceCode/guix/tests/syscalls.scm:521
source:
+ (test-assert
+   "terminal-columns"
+   (> (terminal-columns) 0))
actual-value: #t
result: PASS

test-name: terminal-columns non-file port
location: /data/paul/sourceCode/guix/tests/syscalls.scm:524
source:
+ (test-assert
+   "terminal-columns non-file port"
+   (> (terminal-columns
+        (open-input-string
+          "Join us now, share the software!"))
+      0))
actual-value: #t
result: PASS

test-name: utmpx-entries
location: /data/paul/sourceCode/guix/tests/syscalls.scm:528
source:
+ (test-assert
+   "utmpx-entries"
+   (match (utmpx-entries)
+          (((? utmpx? entries) ...)
+           (every (lambda (entry)
+                    (match (utmpx-user entry)
+                           ((? string?)
+                            (or (not (memv (utmpx-login-type entry)
+                                           (list (login-type INIT_PROCESS)
+                                                 (login-type LOGIN_PROCESS)
+                                                 (login-type USER_PROCESS))))
+                                (> (utmpx-pid entry) 0)))
+                           (#f #t)))
+                  entries))))
actual-value: #t
result: PASS

test-name: read-utmpx, EOF
location: /data/paul/sourceCode/guix/tests/syscalls.scm:545
source:
+ (test-assert
+   "read-utmpx, EOF"
+   (eof-object? (read-utmpx (%make-void-port "r"))))
actual-value: #t
result: PASS

test-name: read-utmpx
location: /data/paul/sourceCode/guix/tests/syscalls.scm:550
source:
+ (test-assert
+   "read-utmpx"
+   (let ((result
+           (call-with-input-file
+             "/var/run/utmpx"
+             read-utmpx)))
+     (or (utmpx? result) (eof-object? result))))
result: SKIP


             reply	other threads:[~2018-06-26 14:18 UTC|newest]

Thread overview: 9+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2018-06-26 14:16 Paul Garlick [this message]
2020-12-01 18:12 ` bug#31977: clone tests fail on CentOS 7 zimoun
2020-12-02 18:08   ` Paul Garlick
2020-12-03 16:34   ` Paul Garlick
2020-12-07  0:54     ` zimoun
2020-12-19  9:26       ` zimoun
2020-12-21 15:29         ` Paul Garlick
2022-10-08 14:30           ` zimoun
2022-11-03  9:47             ` zimoun

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://guix.gnu.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=1530022595.3353.22.camel@tourbillion-technology.com \
    --to=pgarlick@tourbillion-technology.com \
    --cc=31977@debbugs.gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).