summaryrefslogtreecommitdiff
path: root/gnu/tests/nfs.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-07-18 10:41:51 +0200
committerLudovic Courtès <ludo@gnu.org>2017-07-20 11:57:13 +0200
commit8b113790fa3bfd2300c737901ba161f079fedbdf (patch)
tree72b7aa4fa9be2a6c129b97b04a11cfbe0d298a79 /gnu/tests/nfs.scm
parented419fa0c56e6ff3aa8bd8e8f100a81442c51e6d (diff)
tests: Use 'virtual-machine' records instead of monadic procedures.
* gnu/tests/base.scm (%test-basic-os): Use 'let*' instead of 'mlet*' and 'virtual-machine' instead of 'system-qemu-image/shared-store-script'. (run-mcron-test): Likewise. (run-nss-mdns-test): Likewise. * gnu/tests/dict.scm (run-dicod-test): Likewise. * gnu/tests/mail.scm (run-opensmtpd-test): Likewise. (run-exim-test): Likewise. * gnu/tests/messaging.scm (run-xmpp-test): Likewise. * gnu/tests/networking.scm (run-inetd-test): Likewise. * gnu/tests/nfs.scm (run-nfs-test): Likewise. * gnu/tests/ssh.scm (run-ssh-test): Likewise. * gnu/tests/web.scm (run-nginx-test): Likewise.
Diffstat (limited to 'gnu/tests/nfs.scm')
-rw-r--r--gnu/tests/nfs.scm140
1 files changed, 70 insertions, 70 deletions
diff --git a/gnu/tests/nfs.scm b/gnu/tests/nfs.scm
index 9e1ac1d55a..2e666b2c08 100644
--- a/gnu/tests/nfs.scm
+++ b/gnu/tests/nfs.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 John Darrington <jmd@gnu.org>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;;
@@ -55,75 +55,75 @@
(define (run-nfs-test name socket)
"Run a test of an OS running RPC-SERVICE, which should create SOCKET."
- (mlet* %store-monad ((os -> (marionette-operating-system
- %base-os
- #:imported-modules '((gnu services herd)
- (guix combinators))))
- (command (system-qemu-image/shared-store-script
- os #:graphic? #f)))
- (define test
- (with-imported-modules '((gnu build marionette))
- #~(begin
- (use-modules (gnu build marionette)
- (srfi srfi-64))
-
- (define marionette
- (make-marionette (list #$command)))
-
- (define (wait-for-socket file)
- ;; Wait until SOCKET exists in the guest
- (marionette-eval
- `(let loop ((i 10))
- (cond ((and (file-exists? ,file)
- (eq? 'socket (stat:type (stat ,file))))
- #t)
- ((> i 0)
- (sleep 1)
- (loop (- i 1)))
- (else
- (error "Socket didn't show up: " ,file))))
- marionette))
-
- (mkdir #$output)
- (chdir #$output)
-
- (test-begin "rpc-daemon")
-
- ;; Wait for the rpcbind daemon to be up and running.
- (test-eq "RPC service running"
- 'running!
- (marionette-eval
- '(begin
- (use-modules (gnu services herd))
- (start-service 'rpcbind-daemon)
- 'running!)
- marionette))
-
- ;; Check the socket file and that the service is still running.
- (test-assert "RPC socket exists"
- (and
- (wait-for-socket #$socket)
- (marionette-eval
- '(begin
- (use-modules (gnu services herd)
- (srfi srfi-1))
-
- (live-service-running
- (find (lambda (live)
- (memq 'rpcbind-daemon
- (live-service-provision live)))
- (current-services))))
- marionette)))
-
- (test-assert "Probe RPC daemon"
- (marionette-eval
- '(zero? (system* "rpcinfo" "-p"))
- marionette))
-
- (test-end)
- (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
-
- (gexp->derivation name test)))
+ (define os
+ (marionette-operating-system
+ %base-os
+ #:imported-modules '((gnu services herd)
+ (guix combinators))))
+
+ (define test
+ (with-imported-modules '((gnu build marionette))
+ #~(begin
+ (use-modules (gnu build marionette)
+ (srfi srfi-64))
+
+ (define marionette
+ (make-marionette (list #$(virtual-machine os))))
+
+ (define (wait-for-socket file)
+ ;; Wait until SOCKET exists in the guest
+ (marionette-eval
+ `(let loop ((i 10))
+ (cond ((and (file-exists? ,file)
+ (eq? 'socket (stat:type (stat ,file))))
+ #t)
+ ((> i 0)
+ (sleep 1)
+ (loop (- i 1)))
+ (else
+ (error "Socket didn't show up: " ,file))))
+ marionette))
+
+ (mkdir #$output)
+ (chdir #$output)
+
+ (test-begin "rpc-daemon")
+
+ ;; Wait for the rpcbind daemon to be up and running.
+ (test-eq "RPC service running"
+ 'running!
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (start-service 'rpcbind-daemon)
+ 'running!)
+ marionette))
+
+ ;; Check the socket file and that the service is still running.
+ (test-assert "RPC socket exists"
+ (and
+ (wait-for-socket #$socket)
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd)
+ (srfi srfi-1))
+
+ (live-service-running
+ (find (lambda (live)
+ (memq 'rpcbind-daemon
+ (live-service-provision live)))
+ (current-services))))
+ marionette)))
+
+ (test-assert "Probe RPC daemon"
+ (marionette-eval
+ '(zero? (system* "rpcinfo" "-p"))
+ marionette))
+
+ (test-end)
+ (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+ (gexp->derivation name test))
(define %test-nfs
(system-test