1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-03 11:33:37 +00:00

* automated/dbus-tests.el (dbus-test02-register-service-session)

(dbus-test02-register-service-system): Fix docstring.
(dbus-test02-register-service-own-bus)
(dbus-test03-peer-interface): New tests.
This commit is contained in:
Michael Albinus 2014-07-04 12:07:45 +02:00
parent b39eecb3c7
commit a984543a44
2 changed files with 55 additions and 2 deletions

View File

@ -1,3 +1,10 @@
2014-07-04 Michael Albinus <michael.albinus@gmx.de>
* automated/dbus-tests.el (dbus-test02-register-service-session)
(dbus-test02-register-service-system): Fix docstring.
(dbus-test02-register-service-own-bus)
(dbus-test03-peer-interface): New tests.
2014-07-03 Fabián Ezequiel Gallina <fgallina@gnu.org>
* automated/python-tests.el (python-tests-self-insert): New function.

View File

@ -103,7 +103,7 @@
(should-error (dbus-unregister-service bus dbus-service-dbus)))
(ert-deftest dbus-test02-register-service-session ()
"Check service registration at `:session'."
"Check service registration at `:session' bus."
(skip-unless (and dbus--test-enabled-session-bus
(dbus-register-service :session dbus-service-emacs)))
(dbus--test-register-service :session)
@ -121,11 +121,57 @@
(should (eq (dbus-unregister-service :session service) :not-owner)))))
(ert-deftest dbus-test02-register-service-system ()
"Check service registration at `:system'."
"Check service registration at `:system' bus."
(skip-unless (and dbus--test-enabled-system-bus
(dbus-register-service :system dbus-service-emacs)))
(dbus--test-register-service :system))
(ert-deftest dbus-test02-register-service-own-bus ()
"Check service registration with an own bus.
This includes initialization and closing the bus."
;; Start bus.
(let ((output
(ignore-errors
(shell-command-to-string "dbus-launch --sh-syntax")))
bus pid)
(skip-unless (stringp output))
(when (string-match "DBUS_SESSION_BUS_ADDRESS='\\(.+\\)';" output)
(setq bus (match-string 1 output)))
(when (string-match "DBUS_SESSION_BUS_PID=\\([[:digit:]]+\\);" output)
(setq pid (match-string 1 output)))
(unwind-protect
(progn
(skip-unless
(dbus-ignore-errors
(and bus pid
(featurep 'dbusbind)
(dbus-init-bus bus)
(dbus-get-unique-name bus)
(dbus-register-service bus dbus-service-emacs))))
;; Run the test.
(dbus--test-register-service bus))
;; Save exit.
(when pid (call-process "kill" nil nil nil pid)))))
(ert-deftest dbus-test03-peer-interface ()
"Check `dbus-interface-peer' methods."
(skip-unless
(and dbus--test-enabled-session-bus
(dbus-register-service :session dbus-service-emacs)
;; "GetMachineId" is not implemented (yet). When it returns a
;; value, another D-Bus client like dbus-monitor is reacting
;; on `dbus-interface-peer'. We cannot test then.
(not
(dbus-ignore-errors
(dbus-call-method
:session dbus-service-emacs dbus-path-dbus
dbus-interface-peer "GetMachineId" :timeout 100)))))
(should (dbus-ping :session dbus-service-emacs 100))
(dbus-unregister-service :session dbus-service-emacs)
(should-not (dbus-ping :session dbus-service-emacs 100)))
(defun dbus-test-all (&optional interactive)
"Run all tests for \\[dbus]."
(interactive "p")