summaryrefslogtreecommitdiff
path: root/gnu/tests
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2016-07-03 23:11:40 +0200
committerLudovic Courtès <ludo@gnu.org>2016-07-12 22:47:08 +0200
commit4ee96a7912eef8c41c855c680f924dcdba2d9c97 (patch)
tree3a327f5c28ae0fbfdb135ceb96be8d799422a577 /gnu/tests
parent0bb9929eaa3f963ae75478e789723f9e8582116b (diff)
gnu: Switch to 'with-imported-modules'.
* gnu/services.scm (directory-union): Use 'with-imported-modules' instead of the '#:modules' argument of 'computed-file'. * gnu/services/base.scm (udev-rules-union): Likewise. * gnu/services/dbus.scm (system-service-directory): Likewise. * gnu/services/desktop.scm (wrapped-dbus-service): (polkit-directory): Likewise. * gnu/services/networking.scm (tor-configuration->torrc): Likewise. * gnu/services/xorg.scm (xorg-configuration-directory): Likewise. * gnu/system/install.scm (self-contained-tarball): Likewise. * gnu/system/linux-container.scm (container-script): Likewise. * gnu/system/linux-initrd.scm (expression->initrd): Likewise, and remove #:modules parameter. (flat-linux-module-directory): Use 'with-imported-modules'. (base-initrd): Likewise. * gnu/system/locale.scm (locale-directory): Likewise. * gnu/system/shadow.scm (default-skeletons): Likewise. * gnu/system/vm.scm (expression->derivation-in-linux-vm): Likewise. * gnu/tests/base.scm (run-basic-test): Likewise. * gnu/tests/install.scm (run-install): Likewise. * doc/guix.texi (Initial RAM Disk): Update 'expression->initrd' documentation.
Diffstat (limited to 'gnu/tests')
-rw-r--r--gnu/tests/base.scm514
-rw-r--r--gnu/tests/install.scm82
2 files changed, 298 insertions, 298 deletions
diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm
index 0013b465b4..a6278b25d4 100644
--- a/gnu/tests/base.scm
+++ b/gnu/tests/base.scm
@@ -70,125 +70,125 @@
using COMMAND, a gexp that evaluates to a list of strings. Compare some
properties of running system to what's declared in OS, an <operating-system>."
(define test
- #~(begin
- (use-modules (gnu build marionette)
- (srfi srfi-1)
- (srfi srfi-26)
- (srfi srfi-64)
- (ice-9 match))
-
- (define marionette
- (make-marionette #$command))
-
- (mkdir #$output)
- (chdir #$output)
-
- (test-begin "basic")
-
- (test-assert "uname"
- (match (marionette-eval '(uname) marionette)
- (#("Linux" host-name version _ architecture)
- (and (string=? host-name
- #$(operating-system-host-name os))
- (string-prefix? #$(package-version
- (operating-system-kernel os))
- version)
- (string-prefix? architecture %host-type)))))
-
- (test-assert "shell and user commands"
- ;; Is everything in $PATH?
- (zero? (marionette-eval '(system "
+ (with-imported-modules '((gnu build marionette))
+ #~(begin
+ (use-modules (gnu build marionette)
+ (srfi srfi-1)
+ (srfi srfi-26)
+ (srfi srfi-64)
+ (ice-9 match))
+
+ (define marionette
+ (make-marionette #$command))
+
+ (mkdir #$output)
+ (chdir #$output)
+
+ (test-begin "basic")
+
+ (test-assert "uname"
+ (match (marionette-eval '(uname) marionette)
+ (#("Linux" host-name version _ architecture)
+ (and (string=? host-name
+ #$(operating-system-host-name os))
+ (string-prefix? #$(package-version
+ (operating-system-kernel os))
+ version)
+ (string-prefix? architecture %host-type)))))
+
+ (test-assert "shell and user commands"
+ ;; Is everything in $PATH?
+ (zero? (marionette-eval '(system "
. /etc/profile
set -e -x
guix --version
ls --version
grep --version
info --version")
- marionette)))
-
- (test-assert "accounts"
- (let ((users (marionette-eval '(begin
- (use-modules (ice-9 match))
- (let loop ((result '()))
- (match (getpw)
- (#f (reverse result))
- (x (loop (cons x result))))))
- marionette)))
- (lset= string=?
- (map passwd:name users)
- (list
- #$@(map user-account-name
- (operating-system-user-accounts os))))))
-
- (test-assert "shepherd services"
- (let ((services (marionette-eval '(begin
- (use-modules (gnu services herd))
- (call-with-values current-services
- append))
- marionette)))
- (lset= eq?
- (pk 'services services)
- '(root #$@(operating-system-shepherd-service-names os)))))
-
- (test-equal "login on tty1"
- "root\n"
- (begin
- (marionette-control "sendkey ctrl-alt-f1" marionette)
- ;; Wait for the 'term-tty1' service to be running (using
- ;; 'start-service' is the simplest and most reliable way to do
- ;; that.)
+ marionette)))
+
+ (test-assert "accounts"
+ (let ((users (marionette-eval '(begin
+ (use-modules (ice-9 match))
+ (let loop ((result '()))
+ (match (getpw)
+ (#f (reverse result))
+ (x (loop (cons x result))))))
+ marionette)))
+ (lset= string=?
+ (map passwd:name users)
+ (list
+ #$@(map user-account-name
+ (operating-system-user-accounts os))))))
+
+ (test-assert "shepherd services"
+ (let ((services (marionette-eval '(begin
+ (use-modules (gnu services herd))
+ (call-with-values current-services
+ append))
+ marionette)))
+ (lset= eq?
+ (pk 'services services)
+ '(root #$@(operating-system-shepherd-service-names os)))))
+
+ (test-equal "login on tty1"
+ "root\n"
+ (begin
+ (marionette-control "sendkey ctrl-alt-f1" marionette)
+ ;; Wait for the 'term-tty1' service to be running (using
+ ;; 'start-service' is the simplest and most reliable way to do
+ ;; that.)
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (start-service 'term-tty1))
+ marionette)
+
+ ;; Now we can type.
+ (marionette-type "root\n\nid -un > logged-in\n" marionette)
+
+ ;; It can take a while before the shell commands are executed.
+ (let loop ((i 0))
+ (unless (or (file-exists? "/root/logged-in") (> i 15))
+ (sleep 1)
+ (loop (+ i 1))))
+ (marionette-eval '(use-modules (rnrs io ports)) marionette)
+ (marionette-eval '(call-with-input-file "/root/logged-in"
+ get-string-all)
+ marionette)))
+
+ (test-assert "host name resolution"
+ (match (marionette-eval
+ '(begin
+ ;; Wait for nscd or our requests go through it.
+ (use-modules (gnu services herd))
+ (start-service 'nscd)
+
+ (list (getaddrinfo "localhost")
+ (getaddrinfo #$(operating-system-host-name os))))
+ marionette)
+ ((((? vector?) ..1) ((? vector?) ..1))
+ #t)
+ (x
+ (pk 'failure x #f))))
+
+ (test-equal "host not found"
+ #f
(marionette-eval
- '(begin
- (use-modules (gnu services herd))
- (start-service 'term-tty1))
- marionette)
-
- ;; Now we can type.
- (marionette-type "root\n\nid -un > logged-in\n" marionette)
-
- ;; It can take a while before the shell commands are executed.
- (let loop ((i 0))
- (unless (or (file-exists? "/root/logged-in") (> i 15))
- (sleep 1)
- (loop (+ i 1))))
- (marionette-eval '(use-modules (rnrs io ports)) marionette)
- (marionette-eval '(call-with-input-file "/root/logged-in"
- get-string-all)
- marionette)))
-
- (test-assert "host name resolution"
- (match (marionette-eval
- '(begin
- ;; Wait for nscd or our requests go through it.
- (use-modules (gnu services herd))
- (start-service 'nscd)
-
- (list (getaddrinfo "localhost")
- (getaddrinfo #$(operating-system-host-name os))))
- marionette)
- ((((? vector?) ..1) ((? vector?) ..1))
- #t)
- (x
- (pk 'failure x #f))))
-
- (test-equal "host not found"
- #f
- (marionette-eval
- '(false-if-exception (getaddrinfo "does-not-exist"))
- marionette))
-
- (test-assert "screendump"
- (begin
- (marionette-control (string-append "screendump " #$output
- "/tty1.ppm")
- marionette)
- (file-exists? "tty1.ppm")))
-
- (test-end)
- (exit (= (test-runner-fail-count (test-runner-current)) 0))))
-
- (gexp->derivation name test
- #:modules '((gnu build marionette))))
+ '(false-if-exception (getaddrinfo "does-not-exist"))
+ marionette))
+
+ (test-assert "screendump"
+ (begin
+ (marionette-control (string-append "screendump " #$output
+ "/tty1.ppm")
+ marionette)
+ (file-exists? "tty1.ppm")))
+
+ (test-end)
+ (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+ (gexp->derivation name test))
(define %test-basic-os
(system-test
@@ -243,67 +243,67 @@ functionality tests.")
(command (system-qemu-image/shared-store-script
os #:graphic? #f)))
(define test
- #~(begin
- (use-modules (gnu build marionette)
- (srfi srfi-64)
- (ice-9 match))
-
- (define marionette
- (make-marionette (list #$command)))
-
- (define (wait-for-file file)
- ;; Wait until FILE exists in the guest; 'read' its content and
- ;; return it.
- (marionette-eval
- `(let loop ((i 10))
- (cond ((file-exists? ,file)
- (call-with-input-file ,file read))
- ((> i 0)
- (sleep 1)
- (loop (- i 1)))
- (else
- (error "file didn't show up" ,file))))
- marionette))
-
- (mkdir #$output)
- (chdir #$output)
-
- (test-begin "mcron")
-
- (test-eq "service running"
- 'running!
- (marionette-eval
- '(begin
- (use-modules (gnu services herd))
- (start-service 'mcron)
- 'running!)
- marionette))
-
- ;; Make sure root's mcron job runs, has its cwd set to "/root", and
- ;; runs with the right UID/GID.
- (test-equal "root's job"
- '(0 0)
- (wait-for-file "/root/witness"))
-
- ;; Likewise for Alice's job. We cannot know what its GID is since
- ;; it's chosen by 'groupadd', but it's strictly positive.
- (test-assert "alice's job"
- (match (wait-for-file "/home/alice/witness")
- ((1000 gid)
- (>= gid 100))))
-
- ;; Last, the job that uses a command; allows us to test whether
- ;; $PATH is sane. (Note that 'marionette-eval' stringifies objects
- ;; that don't have a read syntax, hence the string.)
- (test-equal "root's job with command"
- "#<eof>"
- (wait-for-file "/root/witness-touch"))
-
- (test-end)
- (exit (= (test-runner-fail-count (test-runner-current)) 0))))
-
- (gexp->derivation name test
- #:modules '((gnu build marionette)))))
+ (with-imported-modules '((gnu build marionette))
+ #~(begin
+ (use-modules (gnu build marionette)
+ (srfi srfi-64)
+ (ice-9 match))
+
+ (define marionette
+ (make-marionette (list #$command)))
+
+ (define (wait-for-file file)
+ ;; Wait until FILE exists in the guest; 'read' its content and
+ ;; return it.
+ (marionette-eval
+ `(let loop ((i 10))
+ (cond ((file-exists? ,file)
+ (call-with-input-file ,file read))
+ ((> i 0)
+ (sleep 1)
+ (loop (- i 1)))
+ (else
+ (error "file didn't show up" ,file))))
+ marionette))
+
+ (mkdir #$output)
+ (chdir #$output)
+
+ (test-begin "mcron")
+
+ (test-eq "service running"
+ 'running!
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (start-service 'mcron)
+ 'running!)
+ marionette))
+
+ ;; Make sure root's mcron job runs, has its cwd set to "/root", and
+ ;; runs with the right UID/GID.
+ (test-equal "root's job"
+ '(0 0)
+ (wait-for-file "/root/witness"))
+
+ ;; Likewise for Alice's job. We cannot know what its GID is since
+ ;; it's chosen by 'groupadd', but it's strictly positive.
+ (test-assert "alice's job"
+ (match (wait-for-file "/home/alice/witness")
+ ((1000 gid)
+ (>= gid 100))))
+
+ ;; Last, the job that uses a command; allows us to test whether
+ ;; $PATH is sane. (Note that 'marionette-eval' stringifies objects
+ ;; that don't have a read syntax, hence the string.)
+ (test-equal "root's job with command"
+ "#<eof>"
+ (wait-for-file "/root/witness-touch"))
+
+ (test-end)
+ (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+ (gexp->derivation name test)))
(define %test-mcron
(system-test
@@ -355,90 +355,90 @@ functionality tests.")
".local"))
(define test
- #~(begin
- (use-modules (gnu build marionette)
- (srfi srfi-1)
- (srfi srfi-64)
- (ice-9 match))
-
- (define marionette
- (make-marionette (list #$run)))
-
- (mkdir #$output)
- (chdir #$output)
-
- (test-begin "avahi")
-
- (test-assert "wait for services"
- (marionette-eval
- '(begin
- (use-modules (gnu services herd))
-
- (start-service 'nscd)
-
- ;; XXX: Work around a race condition in nscd: nscd creates its
- ;; PID file before it is listening on its socket.
- (let ((sock (socket PF_UNIX SOCK_STREAM 0)))
- (let try ()
- (catch 'system-error
- (lambda ()
- (connect sock AF_UNIX "/var/run/nscd/socket")
- (close-port sock)
- (format #t "nscd is ready~%"))
- (lambda args
- (format #t "waiting for nscd...~%")
- (usleep 500000)
- (try)))))
-
- ;; Wait for the other useful things.
- (start-service 'avahi-daemon)
- (start-service 'networking)
-
- #t)
- marionette))
-
- (test-equal "avahi-resolve-host-name"
- 0
- (marionette-eval
- '(system*
- "/run/current-system/profile/bin/avahi-resolve-host-name"
- "-v" #$mdns-host-name)
- marionette))
-
- (test-equal "avahi-browse"
- 0
- (marionette-eval
- '(system* "avahi-browse" "-avt")
- marionette))
-
- (test-assert "getaddrinfo .local"
- ;; Wait for the 'avahi-daemon' service and perform a resolution.
- (match (marionette-eval
- '(getaddrinfo #$mdns-host-name)
- marionette)
- (((? vector? addrinfos) ..1)
- (pk 'getaddrinfo addrinfos)
- (and (any (lambda (ai)
- (= AF_INET (addrinfo:fam ai)))
- addrinfos)
- (any (lambda (ai)
- (= AF_INET6 (addrinfo:fam ai)))
- addrinfos)))))
-
- (test-assert "gethostbyname .local"
- (match (pk 'gethostbyname
- (marionette-eval '(gethostbyname #$mdns-host-name)
- marionette))
- ((? vector? result)
- (and (string=? (hostent:name result) #$mdns-host-name)
- (= (hostent:addrtype result) AF_INET)))))
-
-
- (test-end)
- (exit (= (test-runner-fail-count (test-runner-current)) 0))))
-
- (gexp->derivation "nss-mdns" test
- #:modules '((gnu build marionette)))))
+ (with-imported-modules '((gnu build marionette))
+ #~(begin
+ (use-modules (gnu build marionette)
+ (srfi srfi-1)
+ (srfi srfi-64)
+ (ice-9 match))
+
+ (define marionette
+ (make-marionette (list #$run)))
+
+ (mkdir #$output)
+ (chdir #$output)
+
+ (test-begin "avahi")
+
+ (test-assert "wait for services"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+
+ (start-service 'nscd)
+
+ ;; XXX: Work around a race condition in nscd: nscd creates its
+ ;; PID file before it is listening on its socket.
+ (let ((sock (socket PF_UNIX SOCK_STREAM 0)))
+ (let try ()
+ (catch 'system-error
+ (lambda ()
+ (connect sock AF_UNIX "/var/run/nscd/socket")
+ (close-port sock)
+ (format #t "nscd is ready~%"))
+ (lambda args
+ (format #t "waiting for nscd...~%")
+ (usleep 500000)
+ (try)))))
+
+ ;; Wait for the other useful things.
+ (start-service 'avahi-daemon)
+ (start-service 'networking)
+
+ #t)
+ marionette))
+
+ (test-equal "avahi-resolve-host-name"
+ 0
+ (marionette-eval
+ '(system*
+ "/run/current-system/profile/bin/avahi-resolve-host-name"
+ "-v" #$mdns-host-name)
+ marionette))
+
+ (test-equal "avahi-browse"
+ 0
+ (marionette-eval
+ '(system* "avahi-browse" "-avt")
+ marionette))
+
+ (test-assert "getaddrinfo .local"
+ ;; Wait for the 'avahi-daemon' service and perform a resolution.
+ (match (marionette-eval
+ '(getaddrinfo #$mdns-host-name)
+ marionette)
+ (((? vector? addrinfos) ..1)
+ (pk 'getaddrinfo addrinfos)
+ (and (any (lambda (ai)
+ (= AF_INET (addrinfo:fam ai)))
+ addrinfos)
+ (any (lambda (ai)
+ (= AF_INET6 (addrinfo:fam ai)))
+ addrinfos)))))
+
+ (test-assert "gethostbyname .local"
+ (match (pk 'gethostbyname
+ (marionette-eval '(gethostbyname #$mdns-host-name)
+ marionette))
+ ((? vector? result)
+ (and (string=? (hostent:name result) #$mdns-host-name)
+ (= (hostent:addrtype result) AF_INET)))))
+
+
+ (test-end)
+ (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+ (gexp->derivation "nss-mdns" test)))
(define %test-nss-mdns
(system-test
diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm
index 2c0db41d69..3c83da151a 100644
--- a/gnu/tests/install.scm
+++ b/gnu/tests/install.scm
@@ -119,43 +119,45 @@ TARGET-SIZE bytes containing the installed system."
os (list target))
#:disk-image-size (* 1500 MiB))))
(define install
- #~(begin
- (use-modules (guix build utils)
- (gnu build marionette))
-
- (set-path-environment-variable "PATH" '("bin")
- (list #$qemu-minimal))
-
- (system* "qemu-img" "create" "-f" "qcow2"
- #$output #$(number->string target-size))
-
- (define marionette
- (make-marionette
- (cons (which #$(qemu-command system))
- (cons* "-no-reboot" "-m" "800"
- "-drive"
- (string-append "file=" #$image
- ",if=virtio,readonly")
- "-drive"
- (string-append "file=" #$output ",if=virtio")
- (if (file-exists? "/dev/kvm")
- '("-enable-kvm")
- '())))))
-
- (pk 'uname (marionette-eval '(uname) marionette))
-
- ;; Wait for tty1.
- (marionette-eval '(begin
- (use-modules (gnu services herd))
- (start 'term-tty1))
- marionette)
-
- (marionette-eval '(call-with-output-file "/etc/litl-config.scm"
- (lambda (port)
- (write '#$%minimal-os-source port)))
- marionette)
-
- (exit (marionette-eval '(zero? (system "
+ (with-imported-modules '((guix build utils)
+ (gnu build marionette))
+ #~(begin
+ (use-modules (guix build utils)
+ (gnu build marionette))
+
+ (set-path-environment-variable "PATH" '("bin")
+ (list #$qemu-minimal))
+
+ (system* "qemu-img" "create" "-f" "qcow2"
+ #$output #$(number->string target-size))
+
+ (define marionette
+ (make-marionette
+ (cons (which #$(qemu-command system))
+ (cons* "-no-reboot" "-m" "800"
+ "-drive"
+ (string-append "file=" #$image
+ ",if=virtio,readonly")
+ "-drive"
+ (string-append "file=" #$output ",if=virtio")
+ (if (file-exists? "/dev/kvm")
+ '("-enable-kvm")
+ '())))))
+
+ (pk 'uname (marionette-eval '(uname) marionette))
+
+ ;; Wait for tty1.
+ (marionette-eval '(begin
+ (use-modules (gnu services herd))
+ (start 'term-tty1))
+ marionette)
+
+ (marionette-eval '(call-with-output-file "/etc/litl-config.scm"
+ (lambda (port)
+ (write '#$%minimal-os-source port)))
+ marionette)
+
+ (exit (marionette-eval '(zero? (system "
. /etc/profile
set -e -x;
guix --version
@@ -178,11 +180,9 @@ cp /etc/litl-config.scm /mnt/etc/config.scm
guix system init /mnt/etc/config.scm /mnt --no-substitutes
sync
reboot\n"))
- marionette))))
+ marionette)))))
- (gexp->derivation "installation" install
- #:modules '((guix build utils)
- (gnu build marionette)))))
+ (gexp->derivation "installation" install)))
(define %test-installed-os