nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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.
master
Ludovic Courtès 2017-07-18 10:41:51 +02:00
parent ed419fa0c5
commit 8b113790fa
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
8 changed files with 744 additions and 741 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
gnu/tests/base.scm
View File

@ -34,7 +34,6 @@
#:use-module (gnu packages package-management)
#:use-module (guix gexp)
#:use-module (guix store)
#:use-module (guix monads)
#:use-module (guix packages)
#:use-module (srfi srfi-1)
#:export (run-basic-test
@ -393,17 +392,16 @@ info --version")
"Instrument %SIMPLE-OS, run it in a VM, and run a series of basic
functionality tests.")
(value
(mlet* %store-monad ((os -> (marionette-operating-system
(let* ((os (marionette-operating-system
%simple-os
#:imported-modules '((gnu services herd)
(guix combinators))))
(run (system-qemu-image/shared-store-script
os #:graphic? #f)))
(vm (virtual-machine os)))
;; XXX: Add call to 'virtualized-operating-system' to get the exact same
;; set of services as the OS produced by
;; 'system-qemu-image/shared-store-script'.
(run-basic-test (virtualized-operating-system os '())
#~(list #$run))))))
#~(list #$vm))))))
;;;
@ -430,12 +428,12 @@ functionality tests.")
(mcron-service (list job1 job2 job3)))))
(define (run-mcron-test name)
(mlet* %store-monad ((os -> (marionette-operating-system
(define os
(marionette-operating-system
%mcron-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
@ -444,7 +442,7 @@ functionality tests.")
(ice-9 match))
(define marionette
(make-marionette (list #$command)))
(make-marionette (list #$(virtual-machine os))))
(mkdir #$output)
(chdir #$output)
@ -483,7 +481,7 @@ functionality tests.")
(test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0)))))
(gexp->derivation name test)))
(gexp->derivation name test))
(define %test-mcron
(system-test
@ -526,13 +524,13 @@ functionality tests.")
;; *after* nscd. Failing to do that, libc will try to connect to nscd,
;; fail, then never try again (see '__nss_not_use_nscd_hosts' in libc),
;; leading to '.local' resolution failures.
(mlet* %store-monad ((os -> (marionette-operating-system
(define os
(marionette-operating-system
%avahi-os
#:requirements '(nscd)
#:imported-modules '((gnu services herd)
(guix combinators))))
(run (system-qemu-image/shared-store-script
os #:graphic? #f)))
(define mdns-host-name
(string-append (operating-system-host-name os)
".local"))
@ -546,7 +544,7 @@ functionality tests.")
(ice-9 match))
(define marionette
(make-marionette (list #$run)))
(make-marionette (list #$(virtual-machine os))))
(mkdir #$output)
(chdir #$output)
@ -621,7 +619,7 @@ functionality tests.")
(test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0)))))
(gexp->derivation "nss-mdns" test)))
(gexp->derivation "nss-mdns" test))
(define %test-nss-mdns
(system-test

17
gnu/tests/dict.scm
View File

@ -27,7 +27,6 @@
#:use-module (gnu packages wordnet)
#:use-module (guix gexp)
#:use-module (guix store)
#:use-module (guix monads)
#:use-module (guix packages)
#:use-module (guix modules)
#:export (%test-dicod))
@ -54,12 +53,17 @@
(define* (run-dicod-test)
"Run tests of 'dicod-service-type'."
(mlet* %store-monad ((os -> (marionette-operating-system
(define os
(marionette-operating-system
%dicod-os
#:imported-modules
(source-module-closure '((gnu services herd)))))
(command (system-qemu-image/shared-store-script
os #:graphic? #f)))
(define vm
(virtual-machine
(operating-system os)
(port-forwardings '((8000 . 2628)))))
(define test
(with-imported-modules '((gnu build marionette))
#~(begin
@ -69,8 +73,7 @@
(gnu build marionette))
(define marionette
;; Forward the guest's DICT port to local port 8000.
(make-marionette (list #$command "-net"
"user,hostfwd=tcp::8000-:2628")))
(make-marionette (list #$vm)))
(define %dico-socket
(socket PF_INET SOCK_STREAM 0))
@ -133,7 +136,7 @@
(test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0)))))
(gexp->derivation "dicod" test)))
(gexp->derivation "dicod" test))
(define %test-dicod
(system-test

34
gnu/tests/mail.scm
View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Sou Bunnbu <iyzsong@member.fsf.org>
;;; Copyright © 2017 Carlo Zancanaro <carlo@zancanaro.id.au>
;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -25,7 +26,6 @@
#:use-module (gnu services mail)
#:use-module (gnu services networking)
#:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (guix store)
#:use-module (ice-9 ftw)
#:export (%test-opensmtpd
@ -44,11 +44,13 @@ accept from any for local deliver to mbox
(define (run-opensmtpd-test)
"Return a test of an OS running OpenSMTPD service."
(mlet* %store-monad ((command (system-qemu-image/shared-store-script
(marionette-operating-system
(define vm
(virtual-machine
(operating-system (marionette-operating-system
%opensmtpd-os
#:imported-modules '((gnu services herd)))
#:graphic? #f)))
#:imported-modules '((gnu services herd))))
(port-forwardings '((1025 . 25)))))
(define test
(with-imported-modules '((gnu build marionette))
#~(begin
@ -59,9 +61,7 @@ accept from any for local deliver to mbox
(gnu build marionette))
(define marionette
(make-marionette
;; Enable TCP forwarding of the guest's port 25.
'(#$command "-net" "user,hostfwd=tcp::1025-:25")))
(make-marionette '(#$vm)))
(define (read-reply-code port)
"Read a SMTP reply from PORT and return its reply code."
@ -142,7 +142,7 @@ accept from any for local deliver to mbox
(test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0)))))
(gexp->derivation "opensmtpd-test" test)))
(gexp->derivation "opensmtpd-test" test))
(define %test-opensmtpd
(system-test
@ -179,11 +179,13 @@ acl_check_data:
(define (run-exim-test)
"Return a test of an OS running an Exim service."
(mlet* %store-monad ((command (system-qemu-image/shared-store-script
(marionette-operating-system
(define vm
(virtual-machine
(operating-system (marionette-operating-system
%exim-os
#:imported-modules '((gnu services herd)))
#:graphic? #f)))
#:imported-modules '((gnu services herd))))
(port-forwardings '((1025 . 25)))))
(define test
(with-imported-modules '((gnu build marionette)
(ice-9 ftw))
@ -196,9 +198,7 @@ acl_check_data:
(gnu build marionette))
(define marionette
(make-marionette
;; Enable TCP forwarding of the guest's port 25.
'(#$command "-net" "user,hostfwd=tcp::1025-:25")))
(make-marionette '(#$vm)))
(define (read-reply-code port)
"Read a SMTP reply from PORT and return its reply code."
@ -272,7 +272,7 @@ acl_check_data:
(test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0)))))
(gexp->derivation "exim-test" test)))
(gexp->derivation "exim-test" test))
(define %test-exim
(system-test

36
gnu/tests/messaging.scm
View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -26,24 +27,29 @@
#:use-module (gnu packages messaging)
#:use-module (guix gexp)
#:use-module (guix store)
#:use-module (guix monads)
#:export (%test-prosody))
(define (run-xmpp-test name xmpp-service pid-file create-account)
"Run a test of an OS running XMPP-SERVICE, which writes its PID to PID-FILE."
(mlet* %store-monad ((os -> (marionette-operating-system
(define os
(marionette-operating-system
(simple-operating-system (dhcp-client-service)
xmpp-service)
#:imported-modules '((gnu services herd))))
(command (system-qemu-image/shared-store-script
os #:graphic? #f))
(username -> "alice")
(server -> "localhost")
(jid -> (string-append username "@" server))
(password -> "correct horse battery staple")
(port -> 15222)
(message -> "hello world")
(witness -> "/tmp/freetalk-witness"))
(define port 15222)
(define vm
(virtual-machine
(operating-system os)
(port-forwardings `((,port . 5222)))))
(define username "alice")
(define server "localhost")
(define jid (string-append username "@" server))
(define password "correct horse battery staple")
(define message "hello world")
(define witness "/tmp/freetalk-witness")
(define script.ft
(scheme-file
@ -74,11 +80,7 @@
(srfi srfi-64))
(define marionette
;; Enable TCP forwarding of the guest's port 5222.
(make-marionette (list #$command "-net"
(string-append "user,hostfwd=tcp::"
(number->string #$port)
"-:5222"))))
(make-marionette (list #$vm)))
(define (host-wait-for-file file)
;; Wait until FILE exists in the host.
@ -127,7 +129,7 @@
(test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0)))))
(gexp->derivation name test)))
(gexp->derivation name test))
(define %create-prosody-account
(program-file

21
gnu/tests/networking.scm
View File

@ -74,9 +74,15 @@ done" ))))))))))
(define* (run-inetd-test)
"Run tests in %INETD-OS, where the inetd service provides an echo service on
port 7, and a dict service on port 2628."
(mlet* %store-monad ((os -> (marionette-operating-system %inetd-os))
(command (system-qemu-image/shared-store-script
os #:graphic? #f)))
(define os
(marionette-operating-system %inetd-os))
(define vm
(virtual-machine
(operating-system os)
(port-forwardings `((8007 . 7)
(8628 . 2628)))))
(define test
(with-imported-modules '((gnu build marionette))
#~(begin
@ -84,12 +90,7 @@ port 7, and a dict service on port 2628."
(srfi srfi-64)
(gnu build marionette))
(define marionette
;; Forward guest ports 7 and 2628 to host ports 8007 and 8628.
(make-marionette (list #$command "-net"
(string-append
"user"
",hostfwd=tcp::8007-:7"
",hostfwd=tcp::8628-:2628"))))
(make-marionette (list #$vm)))
(mkdir #$output)
(chdir #$output)
@ -127,7 +128,7 @@ port 7, and a dict service on port 2628."
(test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0)))))
(gexp->derivation "inetd-test" test)))
(gexp->derivation "inetd-test" test))
(define %test-inetd
(system-test

12
gnu/tests/nfs.scm
View File

@ -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,12 +55,12 @@
(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
(define 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
@ -68,7 +68,7 @@
(srfi srfi-64))
(define marionette
(make-marionette (list #$command)))
(make-marionette (list #$(virtual-machine os))))
(define (wait-for-socket file)
;; Wait until SOCKET exists in the guest
@ -123,7 +123,7 @@
(test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0)))))
(gexp->derivation name test)))
(gexp->derivation name test))
(define %test-nfs
(system-test

20
gnu/tests/ssh.scm
View File

@ -27,7 +27,6 @@
#:use-module (gnu packages ssh)
#:use-module (guix gexp)
#:use-module (guix store)
#:use-module (guix monads)
#:export (%test-openssh
%test-dropbear))
@ -37,14 +36,16 @@ SSH-SERVICE must be configured to listen on port 22 and to allow for root and
empty-password logins.
When SFTP? is true, run an SFTP server test."
(mlet* %store-monad ((os -> (marionette-operating-system
(simple-operating-system
(dhcp-client-service)
ssh-service)
(define os
(marionette-operating-system
(simple-operating-system (dhcp-client-service) ssh-service)
#:imported-modules '((gnu services herd)
(guix combinators))))
(command (system-qemu-image/shared-store-script
os #:graphic? #f)))
(define vm
(virtual-machine
(operating-system os)
(port-forwardings '((2222 . 22)))))
(define test
(with-imported-modules '((gnu build marionette))
#~(begin
@ -66,8 +67,7 @@ When SFTP? is true, run an SFTP server test."
(define marionette
;; Enable TCP forwarding of the guest's port 22.
(make-marionette (list #$command "-net"
"user,hostfwd=tcp::2222-:22")))
(make-marionette (list #$vm)))
(define (make-session-for-test)
"Make a session with predefined parameters for a test."
@ -172,7 +172,7 @@ root with an empty password."
(test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0)))))
(gexp->derivation name test)))
(gexp->derivation name test))
(define %test-openssh
(system-test

21
gnu/tests/web.scm
View File

@ -27,7 +27,6 @@
#:use-module (gnu services networking)
#:use-module (guix gexp)
#:use-module (guix store)
#:use-module (guix monads)
#:export (%test-nginx))
(define %index.html-contents
@ -65,12 +64,17 @@
(define* (run-nginx-test #:optional (http-port 8042))
"Run tests in %NGINX-OS, which has nginx running and listening on
HTTP-PORT."
(mlet* %store-monad ((os -> (marionette-operating-system
(define os
(marionette-operating-system
%nginx-os
#:imported-modules '((gnu services herd)
(guix combinators))))
(command (system-qemu-image/shared-store-script
os #:graphic? #f)))
(define vm
(virtual-machine
(operating-system os)
(port-forwardings `((8080 . ,http-port)))))
(define test
(with-imported-modules '((gnu build marionette))
#~(begin
@ -81,12 +85,7 @@ HTTP-PORT."
(web response))
(define marionette
;; Forward the guest's HTTP-PORT, where nginx is listening, to
;; port 8080 in the host.
(make-marionette (list #$command "-net"
(string-append
"user,hostfwd=tcp::8080-:"
#$(number->string http-port)))))
(make-marionette (list #$vm)))
(mkdir #$output)
(chdir #$output)
@ -126,7 +125,7 @@ HTTP-PORT."
(test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0)))))
(gexp->derivation "nginx-test" test)))
(gexp->derivation "nginx-test" test))
(define %test-nginx
(system-test