aboutsummaryrefslogtreecommitdiff
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Peter Mikkelsen <petermikkelsen10@gmail.com>
;;; Copyright © 2022 Bruno Victal <mirai@makinata.eu>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu tests audio)
  #:use-module (gnu tests)
  #:use-module (gnu system)
  #:use-module (gnu system vm)
  #:use-module (gnu services)
  #:use-module (gnu services audio)
  #:use-module (gnu services networking)
  #:use-module (gnu packages mpd)
  #:use-module (guix gexp)
  #:export (%test-mpd
            %test-mympd))

(define %mpd-os
  (simple-operating-system
   (service mpd-service-type)))

(define (run-mpd-test)
  "Run tests in %mpd-os, which has mpd running."
  (define os
    (marionette-operating-system
     %mpd-os
     #:imported-modules '((gnu services herd))))

  (define vm
    (virtual-machine os))

  (define test
    (with-imported-modules '((gnu build marionette))
      #~(begin
          (use-modules (srfi srfi-64)
                       (gnu build marionette))
          (define marionette
            (make-marionette (list #$vm)))

          (test-runner-current (system-test-runner #$output))
          (test-begin "mpd")

          (test-assert "service is running"
            (marionette-eval
             '(begin
                (use-modules (gnu services herd))
                (start-service 'mpd))
             marionette))

          (test-assert "mpd listening"
            ;; Wait until mpd is actually listening before spawning 'mpc'.
            (wait-for-tcp-port 6600 marionette))

          (test-equal "mpc connect"
            0
            (marionette-eval
             '(system* #$(file-append mpd-mpc "/bin/mpc"))
             marionette))

          (test-end))))
  (gexp->derivation "mpd-test" test))

(define %test-mpd
  (system-test
   (name "mpd")
   (description "Test that the mpd can run and be connected to.")
   (value (run-mpd-test))))

(define (run-mympd-test)
  (define os (marionette-operating-system
              (simple-operating-system (service dhcp-client-service-type)
                                       (service mympd-service-type))
              #:imported-modules '((gnu services herd))))

  (define vm
    (virtual-machine
     (operating-system os)
     (port-forwardings '((8080 . 80)))))

  (define test
    (with-imported-modules '((gnu build marionette))
      #~(begin
          (use-modules (srfi srfi-64)
                       (srfi srfi-8)
                       (web client)
                       (web response)
                       (gnu build marionette))

          (define marionette
            (make-marionette (list #$vm)))

          (test-runner-current (system-test-runner #$output))
          (test-begin "mympd")
          (test-assert "service is running"
            (marionette-eval '(begin
                                (use-modules (gnu services herd))

                                (start-service 'mympd))
                             marionette))

          (test-assert "HTTP port ready"
            (wait-for-tcp-port 80 marionette))

          (test-equal "http-head"
            200
            (receive (x _) (http-head "http://localhost:8080") (response-code x)))

          (test-end))))
  (gexp->derivation "mympd-test" test))

(define %test-mympd
  (system-test
   (name "mympd")
   (description "Connect to a running myMPD service.")
   (value (run-mympd-test))))
pan>Ludovic Courtès 2018-10-18services: dhcp-client: Deprecate 'dhcp-client-service' procedure....* gnu/services/networking.scm (dhcp-client-service-type): Add default value. * gnu/system/examples/bare-bones.tmpl: Use (service dhcp-client-service-type) instead of (dhcp-client-service). * gnu/system/examples/beaglebone-black.tmpl: Likewise. * gnu/tests/base.scm (%avahi-os): Likewise. * gnu/tests/databases.scm (%memcached-os): Likewise. (%mongodb-os): Likewise. * gnu/tests/dict.scm (%dicod-os): Likewise. * gnu/tests/mail.scm (%opensmtpd-os): Likewise. (%exim-os): Likewise. (%dovecot-os): Likewise. * gnu/tests/messaging.scm (run-xmpp-test): Likewise. (run-bitlbee-test): Likewise. * gnu/tests/monitoring.scm (%prometheus-node-exporter-os): Likewise. * gnu/tests/networking.scm (%inetd-os): Likewise. (run-iptables-test): Likewise. * gnu/tests/nfs.scm (%base-os): Likewise. * gnu/tests/rsync.scm (%rsync-os): Likewise. * gnu/tests/ssh.scm (run-ssh-test): Likewise. * gnu/tests/version-control.scm (%cgit-os): Likewise. (%git-http-os): Likewise. (%gitolite-os): Likewise. * gnu/tests/virtualization.scm (%libvirt-os): Likewise. * gnu/tests/web.scm (%httpd-os): Likewise. (%nginx-os): Likewise. (%varnish-os): Likewise. (%php-fpm-os): Likewise. (%hpcguix-web-os): Likewise. (%tailon-os): Likewise. * tests/guix-system.sh: Likewise. * doc/guix.texi (Networking Services): Document 'dhcp-client-service-type' and remove 'dhcp-client-service'. Ludovic Courtès 2018-06-13tests: Honor the return value of 'start-service'....Since commit dc7b3e56337ee9d8dcd8fe7d5cab71ef536d024f, 'start-service' returns the Shepherd's representation of the service as a sexp, and '#f' if the service fails to start. Also, it doesn't throw an exception when the service fails to start, so relying on an exception instead of relying on its return value is a false positive. * gnu/tests/base.scm (run-nss-mdns-test): Split tests so to check the return value of 'start-service'. (run-mcron-test, run-nss-mdns-test): Use 'test-assert' with the return value of 'start-service'. * gnu/tests/admin.scm (run-tailon-test): Idem. * gnu/tests/dict.scm (run-dicod-test): Idem. * gnu/tests/mail.scm (run-opensmtpd-test, run-exim-test, run-dovecot-test): Idem. * gnu/tests/messaging.scm (run-xmpp-test, run-bitlbee-test): Idem. * gnu/tests/nfs.scm (run-nfs-test): Idem. * gnu/tests/rsync.scm (run-rsync-test): Idem. * gnu/tests/ssh.scm (run-ssh-test): Idem. * gnu/tests/version-control.scm (run-cgit-test, run-git-http-test): Idem. * gnu/tests/web.scm (run-php-fpm-test): Idem. Clément Lassieur 2018-06-01marionette: Add 'wait-for-tcp-port'....* gnu/build/marionette.scm (wait-for-tcp-port): New procedure. * gnu/tests/dict.scm (run-dicod-test)["connect inside"]: Use it instead of the inline loop. Ludovic Courtès 2017-07-20tests: 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. Ludovic Courtès 2017-04-16tests: dicod: Bail out if we cannot connect within 20 seconds....* gnu/tests/dict.scm (run-dicod-test)["connect inside"]: Bail out after 20 seconds of failure to connect. Ludovic Courtès 2017-04-01tests: Add GNU dicod test....* gnu/tests/dict.scm: New file. * gnu/local.mk (GNU_SYSTEM_MODULES): Add it.