[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 39230fa 1/2: Implement typed D-Bus properties (Bug#43252)
|
From: |
Michael Albinus |
|
Subject: |
master 39230fa 1/2: Implement typed D-Bus properties (Bug#43252) |
|
Date: |
Tue, 8 Sep 2020 10:24:31 -0400 (EDT) |
branch: master
commit 39230fadbc7eb5428246334d7e41936e5c06254d
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>
Implement typed D-Bus properties (Bug#43252)
* doc/misc/dbus.texi (Properties and Annotations)
(Receiving Method Call): Document optional type symbol in
`dbus-set-property' and `dbus-register-property'.
* lisp/net/dbus.el (dbus-error-unknown-interface)
(dbus-error-unknown-method, dbus-error-unknown-object)
(dbus-error-unknown-property): New defconsts.
(dbus-peer-handler): Improve error handling.
(dbus-introspect-get-signature): Handle also properties.
(dbus-set-property, dbus-register-property): Allow optional TYPE
symbol for VALUE. (Bug#43252)
(dbus-property-handler): Implement property types. Improve error
handling.
* src/dbusbind.c (dbus-message-internal, dbus-registered-objects-table):
Fix docstring.
* test/lisp/net/dbus-tests.el (dbus-test05-register-property):
Extend test.
(dbus-test05-register-property-several-paths): New test.
---
doc/misc/dbus.texi | 19 ++--
lisp/net/dbus.el | 224 +++++++++++++++++++++++++++-----------------
src/dbusbind.c | 16 ++--
test/lisp/net/dbus-tests.el | 156 ++++++++++++++++++++++++++++--
4 files changed, 306 insertions(+), 109 deletions(-)
diff --git a/doc/misc/dbus.texi b/doc/misc/dbus.texi
index a68cb26..4b2a5dc 100644
--- a/doc/misc/dbus.texi
+++ b/doc/misc/dbus.texi
@@ -744,16 +744,17 @@ result can be any valid D-Bus value, or @code{nil} if
there is no
@end lisp
@end defun
-@defun dbus-set-property bus service path interface property value
+@defun dbus-set-property bus service path interface property [type] value
This function sets the value of @var{property} of @var{interface} to
@var{value}. It will be checked at @var{bus}, @var{service},
-@var{path}. When the value is successfully set, this function returns
-@var{value}. Otherwise, it returns @code{nil}. Example:
+@var{path}. @var{value} can be preceded by a @var{type} symbol. When
+the value is successfully set, this function returns @var{value}.
+Otherwise, it returns @code{nil}. Example:
@lisp
(dbus-set-property
:session "org.kde.kaccess" "/MainApplication"
- "com.trolltech.Qt.QApplication" "doubleClickInterval" 500)
+ "com.trolltech.Qt.QApplication" "doubleClickInterval" :uint16 500)
@result{} 500
@end lisp
@@ -1561,7 +1562,7 @@ The test then runs
@end example
@end defun
-@defun dbus-register-property bus service path interface property access value
&optional emits-signal dont-register-service
+@defun dbus-register-property bus service path interface property access
[type] value &optional emits-signal dont-register-service
With this function, an application declares a @var{property} on the D-Bus
@var{bus}.
@@ -1579,9 +1580,11 @@ discussion of @var{dont-register-service} below).
@var{access} indicates, whether the property can be changed by other
services via D-Bus. It must be either the symbol @code{:read},
-@code{:write} or @code{:readwrite}. @var{value} is the initial value
-of the property, it can be of any valid type (@xref{dbus-call-method},
-for details).
+@code{:write} or @code{:readwrite}.
+
+@var{value} is the initial value of the property, it can be of any
+valid type (@xref{dbus-call-method}, for details). @var{value} can be
+preceded by a @var{type} symbol.
If @var{property} already exists on @var{path}, it will be
overwritten. For properties with access type @code{:read} this is the
diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el
index ba6a66d..525036c 100644
--- a/lisp/net/dbus.el
+++ b/lisp/net/dbus.el
@@ -168,6 +168,19 @@ See /usr/include/dbus-1.0/dbus/dbus-protocol.h.")
(concat dbus-error-dbus ".PropertyReadOnly")
"Property you tried to set is read-only.")
+(defconst dbus-error-unknown-interface
+ (concat dbus-error-dbus ".UnknownInterface")
+ "Interface you invoked a method on isn't known by the object.")
+
+(defconst dbus-error-unknown-method (concat dbus-error-dbus ".UnknownMethod")
+ "Method name you invoked isn't known by the object you invoked it on.")
+
+(defconst dbus-error-unknown-object (concat dbus-error-dbus ".UnknownObject")
+ "Object you invoked a method on isn't known.")
+
+(defconst dbus-error-unknown-property (concat dbus-error-dbus
".UnknownProperty")
+ "Property you tried to access isn't known by the object.")
+
;;; Emacs defaults.
(defconst dbus-service-emacs "org.gnu.Emacs"
@@ -1184,7 +1197,8 @@ check whether SERVICE is already running, you can instead
write
"Default handler for the \"org.freedesktop.DBus.Peer\" interface.
It will be registered for all objects created by `dbus-register-service'."
(let* ((last-input-event last-input-event)
- (method (dbus-event-member-name last-input-event)))
+ (method (dbus-event-member-name last-input-event))
+ (path (dbus-event-path-name last-input-event)))
(cond
;; "Ping" does not return an output parameter.
((string-equal method "Ping")
@@ -1194,7 +1208,11 @@ It will be registered for all objects created by
`dbus-register-service'."
(signal
'dbus-error
(list
- (format "%s.GetMachineId not implemented" dbus-interface-peer)))))))
+ (format "%s.GetMachineId not implemented" dbus-interface-peer))))
+ (t `(:error ,dbus-error-unknown-method
+ ,(format-message
+ "No such method \"%s.%s\" at path \"%s\""
+ dbus-interface-peer method path))))))
;;; D-Bus introspection.
@@ -1386,37 +1404,38 @@ string and a member of the list returned by
(defun dbus-introspect-get-signature
(bus service path interface name &optional direction)
- "Return signature of a `method' or `signal' represented by NAME as a string.
+ "Return signature of a `method', `property' or `signal' represented by NAME.
If NAME is a `method', DIRECTION can be either \"in\" or \"out\".
If DIRECTION is nil, \"in\" is assumed.
-If NAME is a `signal', and DIRECTION is non-nil, DIRECTION must
-be \"out\"."
+If NAME is a `signal' or a `property', DIRECTION is ignored."
;; For methods, we use "in" as default direction.
(let ((object (or (dbus-introspect-get-method
bus service path interface name)
(dbus-introspect-get-signal
+ bus service path interface name)
+ (dbus-introspect-get-property
bus service path interface name))))
- (when (and (string-equal
- "method" (dbus-introspect-get-attribute object "name"))
- (not (stringp direction)))
+ (when (and (eq 'method (car object)) (not (stringp direction)))
(setq direction "in"))
;; In signals, no direction is given.
- (when (string-equal "signal" (dbus-introspect-get-attribute object "name"))
+ (when (eq 'signal (car object))
(setq direction nil))
;; Collect the signatures.
- (mapconcat
- (lambda (x)
- (let ((arg (dbus-introspect-get-argument
- bus service path interface name x)))
- (if (or (not (stringp direction))
- (string-equal
- direction
- (dbus-introspect-get-attribute arg "direction")))
- (dbus-introspect-get-attribute arg "type")
- "")))
- (dbus-introspect-get-argument-names bus service path interface name)
- "")))
+ (if (eq 'property (car object))
+ (dbus-introspect-get-attribute object "type")
+ (mapconcat
+ (lambda (x)
+ (let ((arg (dbus-introspect-get-argument
+ bus service path interface name x)))
+ (if (or (not (stringp direction))
+ (string-equal
+ direction
+ (dbus-introspect-get-attribute arg "direction")))
+ (dbus-introspect-get-attribute arg "type")
+ "")))
+ (dbus-introspect-get-argument-names bus service path interface name)
+ ""))))
;;; D-Bus properties.
@@ -1432,20 +1451,23 @@ valid D-Bus value, or nil if there is no PROPERTY, or
PROPERTY cannot be read."
bus service path dbus-interface-properties
"Get" :timeout 500 interface property))))
-(defun dbus-set-property (bus service path interface property value)
+(defun dbus-set-property (bus service path interface property &rest args)
"Set value of PROPERTY of INTERFACE to VALUE.
-It will be checked at BUS, SERVICE, PATH. When the value is
-successfully set return VALUE. Otherwise, return nil."
+It will be checked at BUS, SERVICE, PATH. VALUE can be preceded
+by a TYPE symbol. When the value is successfully set return
+VALUE. Otherwise, return nil.
+
+\(dbus-set-property BUS SERVICE PATH INTERFACE PROPERTY [TYPE] VALUE)"
(dbus-ignore-errors
;; "Set" requires a variant.
(dbus-call-method
bus service path dbus-interface-properties
- "Set" :timeout 500 interface property (list :variant value))
+ "Set" :timeout 500 interface property (cons :variant args))
;; Return VALUE. The property could have the `:write' access type,
;; so we ignore errors in `dbus-get-property'.
- (or
- (dbus-ignore-errors (dbus-get-property bus service path interface
property))
- value)))
+ (dbus-ignore-errors
+ (or (dbus-get-property bus service path interface property)
+ (if (symbolp (car args)) (cadr args) (car args))))))
(defun dbus-get-all-properties (bus service path interface)
"Return all properties of INTERFACE at BUS, SERVICE, PATH.
@@ -1481,8 +1503,7 @@ Filter out matching PATH."
dbus-registered-objects-table)))
(defun dbus-register-property
- (bus service path interface property access value
- &optional emits-signal dont-register-service)
+ (bus service path interface property access &rest args)
"Register PROPERTY on the D-Bus BUS.
BUS is either a Lisp symbol, `:system' or `:session', or a string
@@ -1496,9 +1517,11 @@ discussion of DONT-REGISTER-SERVICE below). INTERFACE
is the
name of the interface used at PATH, PROPERTY is the name of the
property of INTERFACE. ACCESS indicates, whether the property
can be changed by other services via D-Bus. It must be either
-the symbol `:read', `:write' or `:readwrite'. VALUE is the
-initial value of the property, it can be of any valid type (see
-`dbus-call-method' for details).
+the symbol `:read', `:write' or `:readwrite'.
+
+VALUE is the initial value of the property, it can be of any
+valid type (see `dbus-call-method' for details). VALUE can be
+preceded by a TYPE symbol.
If PROPERTY already exists on PATH, it will be overwritten. For
properties with access type `:read' this is the only way to
@@ -1516,52 +1539,72 @@ not registered. This means that other D-Bus clients
have no way
of noticing the newly registered property. When interfaces are
constructed incrementally by adding single methods or properties
at a time, DONT-REGISTER-SERVICE can be used to prevent other
-clients from discovering the still incomplete interface."
- (unless (member access '(:read :write :readwrite))
- (signal 'wrong-type-argument (list "Access type invalid" access)))
-
- ;; Add handlers for the three property-related methods.
- (dbus-register-method
- bus service path dbus-interface-properties "Get"
- #'dbus-property-handler 'dont-register)
- (dbus-register-method
- bus service path dbus-interface-properties "GetAll"
- #'dbus-property-handler 'dont-register)
- (dbus-register-method
- bus service path dbus-interface-properties "Set"
- #'dbus-property-handler 'dont-register)
-
- ;; Register SERVICE.
- (unless (or dont-register-service (member service (dbus-list-names bus)))
- (dbus-register-service bus service))
-
- ;; Send the PropertiesChanged signal.
- (when emits-signal
- (dbus-send-signal
- bus service path dbus-interface-properties "PropertiesChanged"
- (if (member access '(:read :readwrite))
- `(:array (:dict-entry ,property (:variant ,value)))
- '(:array: :signature "{sv}"))
- (if (eq access :write)
- `(:array ,property)
- '(:array))))
-
- ;; Create a hash table entry. We use nil for the unique name,
- ;; because the property might be accessed from anybody.
- (let ((key (list :property bus interface property))
- (val
- (cons
- (list
- nil service path
- (cons
- (if emits-signal (list access :emits-signal) (list access))
- value))
- (dbus-get-other-registered-properties
- bus service path interface property))))
- (puthash key val dbus-registered-objects-table)
-
- ;; Return the object.
- (list key (list service path))))
+clients from discovering the still incomplete interface.
+
+\(dbus-register-property BUS SERVICE PATH INTERFACE PROPERTY ACCESS \
+[TYPE] VALUE &optional EMITS-SIGNAL DONT-REGISTER-SERVICE)"
+ (let ((type (when (symbolp (car args)) (pop args)))
+ (value (pop args))
+ (emits-signal (pop args))
+ (dont-register-service (pop args)))
+ (unless (member access '(:read :write :readwrite))
+ (signal 'wrong-type-argument (list "Access type invalid" access)))
+ (unless type
+ (setq type
+ (cond
+ ((memq value '(t nil)) :boolean)
+ ((natnump value) :uint32)
+ ((fixnump value) :int32)
+ ((floatp value) :double)
+ ((stringp value) :string)
+ (t
+ (signal 'wrong-type-argument (list "Value type invalid"
value))))))
+
+ ;; Add handlers for the three property-related methods.
+ (dbus-register-method
+ bus service path dbus-interface-properties "Get"
+ #'dbus-property-handler 'dont-register)
+ (dbus-register-method
+ bus service path dbus-interface-properties "GetAll"
+ #'dbus-property-handler 'dont-register)
+ (dbus-register-method
+ bus service path dbus-interface-properties "Set"
+ #'dbus-property-handler 'dont-register)
+
+ ;; Register SERVICE.
+ (unless (or dont-register-service (member service (dbus-list-names bus)))
+ (dbus-register-service bus service))
+
+ ;; Send the PropertiesChanged signal.
+ (when emits-signal
+ (dbus-send-signal
+ bus service path dbus-interface-properties "PropertiesChanged"
+ (if (member access '(:read :readwrite))
+ `(:array
+ (:dict-entry
+ ,property
+ ,(if type (list :variant type value) (list :variant value))))
+ '(:array: :signature "{sv}"))
+ (if (eq access :write)
+ `(:array ,property)
+ '(:array))))
+
+ ;; Create a hash table entry. We use nil for the unique name,
+ ;; because the property might be accessed from anybody.
+ (let ((key (list :property bus interface property))
+ (val
+ (cons
+ (list
+ nil service path
+ (cons
+ (if emits-signal (list access :emits-signal) (list access))
+ (if type (list type value) (list value))))
+ (dbus-get-other-registered-properties
+ bus service path interface property))))
+ (puthash key val dbus-registered-objects-table)
+
+ ;; Return the object.
+ (list key (list service path)))))
(defun dbus-property-handler (&rest args)
"Default handler for the \"org.freedesktop.DBus.Properties\" interface.
@@ -1580,7 +1623,7 @@ It will be registered for all objects created by
`dbus-register-property'."
(object (car (last (car entry)))))
(cond
((not (consp object))
- `(:error ,dbus-error-invalid-args
+ `(:error ,dbus-error-unknown-property
,(format-message
"No such property \"%s\" at path \"%s\"" property path)))
((memq :write (car object))
@@ -1588,7 +1631,7 @@ It will be registered for all objects created by
`dbus-register-property'."
,(format-message
"Property \"%s\" at path \"%s\" is not readable" property path)))
;; Return the result.
- (t `((:variant ,(cdar (last (car entry)))))))))
+ (t (list :variant (cdar (last (car entry))))))))
;; "Set" expects a variant.
((string-equal method "Set")
@@ -1598,7 +1641,7 @@ It will be registered for all objects created by
`dbus-register-property'."
(object (car (last (car entry)))))
(cond
((not (consp object))
- `(:error ,dbus-error-invalid-args
+ `(:error ,dbus-error-unknown-property
,(format-message
"No such property \"%s\" at path \"%s\"" property path)))
((memq :read (car object))
@@ -1606,8 +1649,10 @@ It will be registered for all objects created by
`dbus-register-property'."
,(format-message
"Property \"%s\" at path \"%s\" is not writable" property path)))
(t (puthash (list :property bus interface property)
- (cons (append (butlast (car entry))
- (list (cons (car object) value)))
+ (cons (append
+ (butlast (car entry))
+ ;; Reuse ACCESS und TYPE from registration.
+ (list (list (car object) (cadr object) value)))
(dbus-get-other-registered-properties
bus service path interface property))
dbus-registered-objects-table)
@@ -1639,11 +1684,16 @@ It will be registered for all objects created by
`dbus-register-property'."
(push
(list :dict-entry
(car (last key))
- (list :variant (cdar (last item))))
+ (cons :variant (cdar (last item))))
result)))))
dbus-registered-objects-table)
;; Return the result, or an empty array.
- (list :array (or result '(:signature "{sv}"))))))))
+ (list :array (or result '(:signature "{sv}")))))
+
+ (t `(:error ,dbus-error-unknown-method
+ ,(format-message
+ "No such method \"%s.%s\" at path \"%s\""
+ dbus-interface-properties method path))))))
;;; D-Bus object manager.
@@ -1849,6 +1899,8 @@ this connection to those buses."
;; * Implement org.freedesktop.DBus.ObjectManager.InterfacesAdded and
;; org.freedesktop.DBus.ObjectManager.InterfacesRemoved.
;;
+;; * Cache introspection data.
+;;
;; * Run handlers in own threads.
;;; dbus.el ends here
diff --git a/src/dbusbind.c b/src/dbusbind.c
index b637c0e..af294af 100644
--- a/src/dbusbind.c
+++ b/src/dbusbind.c
@@ -1252,7 +1252,7 @@ The following usages are expected:
`dbus-method-error-internal':
(dbus-message-internal
- dbus-message-type-error BUS SERVICE SERIAL &rest ARGS)
+ dbus-message-type-error BUS SERVICE SERIAL ERROR-NAME &rest ARGS)
usage: (dbus-message-internal &rest REST) */)
(ptrdiff_t nargs, Lisp_Object *args)
@@ -1572,10 +1572,9 @@ xd_read_message_1 (DBusConnection *connection,
Lisp_Object bus)
EVENT_INIT (event);
event.kind = DBUS_EVENT;
event.frame_or_window = Qnil;
- event.arg =
- Fcons (value,
- (mtype == DBUS_MESSAGE_TYPE_ERROR)
- ? (Fcons (build_string (error_name), args)) : args);
+ event.arg = Fcons (value,
+ (mtype == DBUS_MESSAGE_TYPE_ERROR)
+ ? (Fcons (build_string (error_name), args)) : args);
}
else /* DBUS_MESSAGE_TYPE_METHOD_CALL, DBUS_MESSAGE_TYPE_SIGNAL. */
@@ -1748,7 +1747,8 @@ syms_of_dbusbind (void)
DEFSYM (QCstruct, ":struct");
DEFSYM (QCdict_entry, ":dict-entry");
- /* Lisp symbols of objects in `dbus-registered-objects-table'. */
+ /* Lisp symbols of objects in `dbus-registered-objects-table'.
+ `:property', which does exist there as well, is not used here. */
DEFSYM (QCserial, ":serial");
DEFSYM (QCmethod, ":method");
DEFSYM (QCsignal, ":signal");
@@ -1826,8 +1826,8 @@ registered methods and properties, UNAME is nil. PATH is
the object
path of the sending object. All of them can be nil, which means a
wildcard then. OBJECT is either the handler to be called when a D-Bus
message, which matches the key criteria, arrives (TYPE `:method' and
-`:signal'), or a cons cell containing the value of the property (TYPE
-`:property').
+`:signal'), or a list containing the value of the property and its
+attributes (TYPE `:property').
For entries of type `:signal', there is also a fifth element RULE,
which keeps the match string the signal is registered with.
diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el
index 5e72145..cc4bdc1 100644
--- a/test/lisp/net/dbus-tests.el
+++ b/test/lisp/net/dbus-tests.el
@@ -259,6 +259,12 @@ This includes initialization and closing the bus."
(property2 "Property2")
(property3 "Property3"))
+ ;; Not registered property.
+ (should-not
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property1))
+
;; `:read' property.
(should
(equal
@@ -307,12 +313,12 @@ This includes initialization and closing the bus."
:session dbus--test-service dbus--test-path
dbus--test-interface property2))
- ;; `:readwrite' property.
+ ;; `:readwrite' property, typed value (Bug#43252).
(should
(equal
(dbus-register-property
:session dbus--test-service dbus--test-path
- dbus--test-interface property3 :readwrite "baz")
+ dbus--test-interface property3 :readwrite :object-path "/baz")
`((:property :session "org.gnu.Emacs.TestDBus" ,property3)
(,dbus--test-service ,dbus--test-path))))
(should
@@ -320,19 +326,19 @@ This includes initialization and closing the bus."
(dbus-get-property
:session dbus--test-service dbus--test-path
dbus--test-interface property3)
- "baz"))
+ "/baz"))
(should
(string-equal
(dbus-set-property
:session dbus--test-service dbus--test-path
- dbus--test-interface property3 "bazbaz")
- "bazbaz"))
+ dbus--test-interface property3 :object-path "/baz/baz")
+ "/baz/baz"))
(should
(string-equal
(dbus-get-property
:session dbus--test-service dbus--test-path
dbus--test-interface property3)
- "bazbaz"))
+ "/baz/baz"))
;; `dbus-get-all-properties'. We cannot retrieve a value for
;; the property with `:write' access type.
@@ -341,7 +347,7 @@ This includes initialization and closing the bus."
:session dbus--test-service dbus--test-path
dbus--test-interface)))
(should (string-equal (cdr (assoc property1 result)) "foo"))
- (should (string-equal (cdr (assoc property3 result)) "bazbaz"))
+ (should (string-equal (cdr (assoc property3 result)) "/baz/baz"))
(should-not (assoc property2 result))))
;; FIXME: This is wrong! The properties are missing.
@@ -357,6 +363,142 @@ This includes initialization and closing the bus."
;; Cleanup.
(dbus-unregister-service :session dbus--test-service)))
+;; The following test is inspired by Bug#43146.
+(ert-deftest dbus-test05-register-property-several-paths ()
+ "Check property registration for an own service at several paths."
+ (skip-unless dbus--test-enabled-session-bus)
+ (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service))
+
+ (unwind-protect
+ (let ((property1 "Property1")
+ (property2 "Property2")
+ (property3 "Property3"))
+
+ ;; First path.
+ (should
+ (equal
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property1 :readwrite "foo")
+ `((:property :session "org.gnu.Emacs.TestDBus" ,property1)
+ (,dbus--test-service ,dbus--test-path))))
+ (should
+ (equal
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property2 :readwrite "bar")
+ `((:property :session "org.gnu.Emacs.TestDBus" ,property2)
+ (,dbus--test-service ,dbus--test-path))))
+ (should
+ (string-equal
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property1)
+ "foo"))
+ (should
+ (string-equal
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property2)
+ "bar"))
+
+ (should
+ (string-equal
+ (dbus-set-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property1 "foofoo")
+ "foofoo"))
+ (should
+ (string-equal
+ (dbus-set-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property2 "barbar")
+ "barbar"))
+ (should
+ (string-equal
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property1)
+ "foofoo"))
+ (should
+ (string-equal
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property2)
+ "barbar"))
+
+ ;; Second path.
+ (should
+ (equal
+ (dbus-register-property
+ :session dbus--test-service (concat dbus--test-path dbus--test-path)
+ dbus--test-interface property2 :readwrite "foo")
+ `((:property :session "org.gnu.Emacs.TestDBus" ,property2)
+ (,dbus--test-service ,(concat dbus--test-path dbus--test-path)))))
+ (should
+ (equal
+ (dbus-register-property
+ :session dbus--test-service (concat dbus--test-path dbus--test-path)
+ dbus--test-interface property3 :readwrite "bar")
+ `((:property :session "org.gnu.Emacs.TestDBus" ,property3)
+ (,dbus--test-service ,(concat dbus--test-path dbus--test-path)))))
+ (should
+ (string-equal
+ (dbus-get-property
+ :session dbus--test-service (concat dbus--test-path dbus--test-path)
+ dbus--test-interface property2)
+ "foo"))
+ (should
+ (string-equal
+ (dbus-get-property
+ :session dbus--test-service (concat dbus--test-path dbus--test-path)
+ dbus--test-interface property3)
+ "bar"))
+
+ (should
+ (string-equal
+ (dbus-set-property
+ :session dbus--test-service (concat dbus--test-path dbus--test-path)
+ dbus--test-interface property2 "foofoo")
+ "foofoo"))
+ (should
+ (string-equal
+ (dbus-set-property
+ :session dbus--test-service (concat dbus--test-path dbus--test-path)
+ dbus--test-interface property3 "barbar")
+ "barbar"))
+ (should
+ (string-equal
+ (dbus-get-property
+ :session dbus--test-service (concat dbus--test-path dbus--test-path)
+ dbus--test-interface property2)
+ "foofoo"))
+ (should
+ (string-equal
+ (dbus-get-property
+ :session dbus--test-service (concat dbus--test-path dbus--test-path)
+ dbus--test-interface property3)
+ "barbar"))
+
+ ;; Everything is still fine, tested with `dbus-get-all-properties'.
+ (let ((result
+ (dbus-get-all-properties
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface)))
+ (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))))
+
+ ;; Cleanup.
+ (dbus-unregister-service :session dbus--test-service)))
+
(defun dbus-test-all (&optional interactive)
"Run all tests for \\[dbus]."
(interactive "p")