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.

diff --git a/doc/misc/dbus.texi b/doc/misc/dbus.texi
index a68cb26a3e53a7c15584e4368d554a10441c344f..4b2a5dc212299fc5fd3064755d8a4ebb5faec546 100644 (file)
--- 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 ba6a66d79c7c53af1da4121b70bb5c52248b36f1..525036caed7d8dffcfb34b9e7506e6c3e51eb5ff 100644 (file)
--- 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.")
+
 \f
 ;;; 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))))))
 
 \f
 ;;; 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)
+       ""))))
 
 \f
 ;;; 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))))))
 
 \f
 ;;; 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 b637c0e58aa3393f89dd494b39a5461790ef5b2f..af294afe92c67a67cbd557a08efcc907d7f30776 100644 (file)
--- 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 5e721459971ffe39ca4f64ddba72f37c7669eaa2..cc4bdc11ec644b072f06c5c8c2a43dbba65ff7ff 100644 (file)
--- 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")