test/automated/dbus-tests.el

   1 ;;; dbus-tests.el --- Tests of D-Bus integration into Emacs
   2
   3 ;; Copyright (C) 2013-2015 Free Software Foundation, Inc.
   4
   5 ;; Author: Michael Albinus <michael.albinus@gmx.de>
   6
   7 ;; This program is free software: you can redistribute it and/or
   8 ;; modify it under the terms of the GNU General Public License as
   9 ;; published by the Free Software Foundation, either version 3 of the
  10 ;; License, or (at your option) any later version.
  11 ;;
  12 ;; This program is distributed in the hope that it will be useful, but
  13 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 ;; General Public License for more details.
  16 ;;
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with this program.  If not, see `http://www.gnu.org/licenses/'.
  19
  20 ;;; Code:
  21
  22 (require 'ert)
  23 (require 'dbus)
  24
  25 (setq dbus-debug nil)
  26
  27 (defvar dbus--test-enabled-session-bus
  28   (and (featurep 'dbusbind)
  29        (dbus-ignore-errors (dbus-get-unique-name :session)))
  30   "Check, whether we are registered at the session bus.")
  31
  32 (defvar dbus--test-enabled-system-bus
  33   (and (featurep 'dbusbind)
  34        (dbus-ignore-errors (dbus-get-unique-name :system)))
  35   "Check, whether we are registered at the system bus.")
  36
  37 (defun dbus--test-availability (bus)
  38   "Test availability of D-Bus BUS."
  39   (should (dbus-list-names bus))
  40   (should (dbus-list-activatable-names bus))
  41   (should (dbus-list-known-names bus))
  42   (should (dbus-get-unique-name bus)))
  43
  44 (ert-deftest dbus-test00-availability-session ()
  45   "Test availability of D-Bus `:session'."
  46   :expected-result (if dbus--test-enabled-session-bus :passed :failed)
  47   (dbus--test-availability :session))
  48
  49 (ert-deftest dbus-test00-availability-system ()
  50   "Test availability of D-Bus `:system'."
  51   :expected-result (if dbus--test-enabled-system-bus :passed :failed)
  52   (dbus--test-availability :system))
  53
  54 (ert-deftest dbus-test01-type-conversion ()
  55   "Check type conversion functions."
  56   (let ((ustr "0123abc_xyz\x01\xff")
  57         (mstr "Grüß Göttin"))
  58     (should
  59      (string-equal
  60       (dbus-byte-array-to-string (dbus-string-to-byte-array "")) ""))
  61     (should
  62      (string-equal
  63       (dbus-byte-array-to-string (dbus-string-to-byte-array ustr)) ustr))
  64     (should
  65      (string-equal
  66       (dbus-byte-array-to-string (dbus-string-to-byte-array mstr) 'multibyte)
  67       mstr))
  68     ;; Should not work for multibyte strings.
  69     (should-not
  70      (string-equal
  71       (dbus-byte-array-to-string (dbus-string-to-byte-array mstr)) mstr))
  72
  73     (should
  74      (string-equal
  75       (dbus-unescape-from-identifier (dbus-escape-as-identifier "")) ""))
  76     (should
  77      (string-equal
  78       (dbus-unescape-from-identifier (dbus-escape-as-identifier ustr)) ustr))
  79     ;; Should not work for multibyte strings.
  80     (should-not
  81      (string-equal
  82       (dbus-unescape-from-identifier (dbus-escape-as-identifier mstr)) mstr))))
  83
  84 (defun dbus--test-register-service (bus)
  85   "Check service registration at BUS."
  86   ;; Cleanup.
  87   (dbus-ignore-errors (dbus-unregister-service bus dbus-service-emacs))
  88
  89   ;; Register an own service.
  90   (should (eq (dbus-register-service bus dbus-service-emacs) :primary-owner))
  91   (should (member dbus-service-emacs (dbus-list-known-names bus)))
  92   (should (eq (dbus-register-service bus dbus-service-emacs) :already-owner))
  93   (should (member dbus-service-emacs (dbus-list-known-names bus)))
  94
  95   ;; Unregister the service.
  96   (should (eq (dbus-unregister-service bus dbus-service-emacs) :released))
  97   (should-not (member dbus-service-emacs (dbus-list-known-names bus)))
  98   (should (eq (dbus-unregister-service bus dbus-service-emacs) :non-existent))
  99   (should-not (member dbus-service-emacs (dbus-list-known-names bus)))
 100
 101   ;; `dbus-service-dbus' is reserved for the BUS itself.
 102   (should-error (dbus-register-service bus dbus-service-dbus))
 103   (should-error (dbus-unregister-service bus dbus-service-dbus)))
 104
 105 (ert-deftest dbus-test02-register-service-session ()
 106   "Check service registration at `:session' bus."
 107   (skip-unless (and dbus--test-enabled-session-bus
 108                     (dbus-register-service :session dbus-service-emacs)))
 109   (dbus--test-register-service :session)
 110
 111   (let ((service "org.freedesktop.Notifications"))
 112     (when (member service (dbus-list-known-names :session))
 113       ;; Cleanup.
 114       (dbus-ignore-errors (dbus-unregister-service :session service))
 115
 116       (should (eq (dbus-register-service :session service) :in-queue))
 117       (should (eq (dbus-unregister-service :session service) :released))
 118
 119       (should
 120        (eq (dbus-register-service :session service :do-not-queue) :exists))
 121       (should (eq (dbus-unregister-service :session service) :not-owner)))))
 122
 123 (ert-deftest dbus-test02-register-service-system ()
 124   "Check service registration at `:system' bus."
 125   (skip-unless (and dbus--test-enabled-system-bus
 126                     (dbus-register-service :system dbus-service-emacs)))
 127   (dbus--test-register-service :system))
 128
 129 (ert-deftest dbus-test02-register-service-own-bus ()
 130   "Check service registration with an own bus.
 131 This includes initialization and closing the bus."
 132   ;; Start bus.
 133   (let ((output
 134          (ignore-errors
 135            (shell-command-to-string "dbus-launch --sh-syntax")))
 136         bus pid)
 137     (skip-unless (stringp output))
 138     (when (string-match "DBUS_SESSION_BUS_ADDRESS='\\(.+\\)';" output)
 139       (setq bus (match-string 1 output)))
 140     (when (string-match "DBUS_SESSION_BUS_PID=\\([[:digit:]]+\\);" output)
 141       (setq pid (match-string 1 output)))
 142     (unwind-protect
 143         (progn
 144           (skip-unless
 145            (dbus-ignore-errors
 146              (and bus pid
 147                   (featurep 'dbusbind)
 148                   (dbus-init-bus bus)
 149                   (dbus-get-unique-name bus)
 150                   (dbus-register-service bus dbus-service-emacs))))
 151           ;; Run the test.
 152           (dbus--test-register-service bus))
 153
 154       ;; Save exit.
 155       (when pid (call-process "kill" nil nil nil pid)))))
 156
 157 (ert-deftest dbus-test03-peer-interface ()
 158   "Check `dbus-interface-peer' methods."
 159   (skip-unless
 160    (and dbus--test-enabled-session-bus
 161         (dbus-register-service :session dbus-service-emacs)
 162         ;; "GetMachineId" is not implemented (yet).  When it returns a
 163         ;; value, another D-Bus client like dbus-monitor is reacting
 164         ;; on `dbus-interface-peer'.  We cannot test then.
 165         (not
 166          (dbus-ignore-errors
 167            (dbus-call-method
 168             :session dbus-service-emacs dbus-path-dbus
 169             dbus-interface-peer "GetMachineId" :timeout 100)))))
 170
 171   (should (dbus-ping :session dbus-service-emacs 100))
 172   (dbus-unregister-service :session dbus-service-emacs)
 173   (should-not (dbus-ping :session dbus-service-emacs 100)))
 174
 175 (defun dbus-test-all (&optional interactive)
 176   "Run all tests for \\[dbus]."
 177   (interactive "p")
 178   (funcall
 179    (if interactive 'ert-run-tests-interactively 'ert-run-tests-batch) "^dbus"))
 180
 181 (provide 'dbus-tests)
 182 ;;; dbus-tests.el ends here