aboutsummaryrefslogtreecommitdiff
path: root/gnu/tests/nfs.scm
diff options
context:
space:
mode:
authorLeo Famulari <leo@famulari.name>2017-07-23 03:42:12 -0400
committerLeo Famulari <leo@famulari.name>2017-07-23 03:42:12 -0400
commit6c1a317e29c45e85e3a0e050612cdefe470b100c (patch)
treee65dedf933090b1a9f8398655b3b20eba49fae96 /gnu/tests/nfs.scm
parentb7158b767b7fd9f0379dfe08083c48a0cf0f3d50 (diff)
parent9478c05955643f8ff95dabccc1e42b20abb88049 (diff)
downloadguix-6c1a317e29c45e85e3a0e050612cdefe470b100c.tar
guix-6c1a317e29c45e85e3a0e050612cdefe470b100c.tar.gz
Merge branch 'master' into core-updates
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