summary refs log tree commit diff
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)
downloadguix-4ee96a7912eef8c41c855c680f924dcdba2d9c97.tar.gz
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