mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-05 22:20:24 -08:00
Code Issues Projects Releases Wiki Activity

Fix thinko in dbus.el

Browse source 
* doc/misc/dbus.texi (Register Objects): Rename from "Receiving
Method Calls".  Add reference to D-Bus API Design document.

* lisp/net/dbus.el (dbus-managed-objects-handler): Fix thinko.

* test/lisp/net/dbus-tests.el (dbus-test05-register-property)
(dbus-test05-register-property-several-paths): Extend tests.
This commit is contained in:
Michael Albinus 2020-09-09 14:53:26 +02:00
parent 554c158419
commit 4fa5bad400
3 changed files with 41 additions and 16 deletions
Download patch file Download diff file Expand all files Collapse all files

10
doc/misc/dbus.texi
View file

@ -59,7 +59,7 @@ another. An overview of D-Bus can be found at
* Type Conversion:: Mapping Lisp types and D-Bus types.
* Synchronous Methods:: Calling methods in a blocking way.
* Asynchronous Methods:: Calling methods non-blocking.
* Receiving Method Calls:: Offering own methods.
* Register Objects:: Offering own services.
* Signals:: Sending and receiving signals.
* Alternative Buses:: Alternative buses and environments.
* Errors and Events:: Errors and events.
@ -1341,11 +1341,15 @@ message arrives, and @var{handler} is called. Example:
@end defun
@node Receiving Method Calls
@chapter Offering own methods.
@node Register Objects
@chapter Offering own services.
@cindex method calls, returning
@cindex returning method calls
You can offer an own service in D-Bus, which will be visible by other
D-Bus clients. See @uref{https://dbus.freedesktop.org/doc/dbus-api-design.html}
for a discussion of the design.
In order to register methods on the D-Bus, Emacs has to request a well
known name on the D-Bus under which it will be available for other
clients. Names on the D-Bus can be registered and unregistered using

4
lisp/net/dbus.el
View file

@ -1780,7 +1780,7 @@ It will be registered for all objects created by `dbus-register-service'."
;; Check for object path wildcard interfaces.
(maphash
(lambda (key val)
(when (and (equal (butlast key 2) (list :method bus))
(when (and (equal (butlast key 2) (list :property bus))
(null (nth 2 (car-safe val))))
(push (nth 2 key) interfaces)))
dbus-registered-objects-table)
@ -1789,7 +1789,7 @@ It will be registered for all objects created by `dbus-register-service'."
(maphash
(lambda (key val)
(let ((object (or (nth 2 (car-safe val)) "")))
(when (and (equal (butlast key 2) (list :method bus))
(when (and (equal (butlast key 2) (list :property bus))
(string-prefix-p path object))
(dolist (interface (cons (nth 2 key) interfaces))
(unless (assoc object result)

43
test/lisp/net/dbus-tests.el
View file

@ -348,17 +348,18 @@ This includes initialization and closing the bus."
dbus--test-interface)))
(should (string-equal (cdr (assoc property1 result)) "foo"))
(should (string-equal (cdr (assoc property3 result)) "/baz/baz"))
(should-not (assoc property2 result))))
(should-not (assoc property2 result)))
;; FIXME: This is wrong! The properties are missing.
;; (should
;; (equal
;; (dbus-get-all-managed-objects
;; :session dbus--test-service dbus--test-path)
;; `((,dbus--test-path
;; ((,dbus-interface-peer)
;; (,dbus-interface-objectmanager)
;; (,dbus-interface-properties)))))))
;; `dbus-get-all-managed-objects'. We cannot retrieve a value for
;; the property with `:write' access type.
(let ((result
(dbus-get-all-managed-objects
:session dbus--test-service dbus--test-path)))
(should (setq result (cadr (assoc dbus--test-path result))))
(should (setq result (cadr (assoc dbus--test-interface result))))
(should (string-equal (cdr (assoc property1 result)) "foo"))
(should (string-equal (cdr (assoc property3 result)) "/baz/baz"))
(should-not (assoc property2 result))))
;; Cleanup.
(dbus-unregister-service :session dbus--test-service)))
@ -488,13 +489,33 @@ This includes initialization and closing the bus."
(should (string-equal (cdr (assoc property1 result)) "foofoo"))
(should (string-equal (cdr (assoc property2 result)) "barbar"))
(should-not (assoc property3 result)))
(let ((result
(dbus-get-all-properties
:session dbus--test-service
(concat dbus--test-path dbus--test-path) dbus--test-interface)))
(should (string-equal (cdr (assoc property2 result)) "foofoo"))
(should (string-equal (cdr (assoc property3 result)) "barbar"))
(should-not (assoc property1 result))))
(should-not (assoc property1 result)))
;; Final check with `dbus-get-all-managed-objects'.
(let ((result
(dbus-get-all-managed-objects :session dbus--test-service "/"))
result1)
(should (setq result1 (cadr (assoc dbus--test-path result))))
(should (setq result1 (cadr (assoc dbus--test-interface result1))))
(should (string-equal (cdr (assoc property1 result1)) "foofoo"))
(should (string-equal (cdr (assoc property2 result1)) "barbar"))
(should-not (assoc property3 result1))
(should
(setq
result1
(cadr (assoc (concat dbus--test-path dbus--test-path) result))))
(should (setq result1 (cadr (assoc dbus--test-interface result1))))
(should (string-equal (cdr (assoc property2 result1)) "foofoo"))
(should (string-equal (cdr (assoc property3 result1)) "barbar"))
(should-not (assoc property1 result1))))
;; Cleanup.
(dbus-unregister-service :session dbus--test-service)))