Stricter checks for D-Bus compound types.

* src/dbusbind.c (XD_DBUS_TYPE_P, Fdbus__init_bus)
(xd_read_queued_messages): Use Fkeywordp instead of SYMBOLP.
(xd_signature): Stricter checks for compound types.

* test/lisp/net/dbus-tests.el (dbus-test01-compound-types): Extend test.

diff --git a/src/dbusbind.c b/src/dbusbind.c
index b06077d3b58b3f0ed88aaf9a605f83fec7425599..36f86556944efcec8c7dd73fe40dd5c9a84794ea 100644 (file)
--- a/src/dbusbind.c
+++ b/src/dbusbind.c
@@ -211,7 +211,7 @@ xd_dbus_type_to_symbol (int type)
 
 /* Check whether a Lisp symbol is a predefined D-Bus type symbol.  */
 #define XD_DBUS_TYPE_P(object)                                         \
-  (SYMBOLP (object) && ((xd_symbol_to_dbus_type (object) != DBUS_TYPE_INVALID)))
+  Fkeywordp (object) && ((xd_symbol_to_dbus_type (object) != DBUS_TYPE_INVALID))
 
 /* Determine the DBusType of a given Lisp OBJECT.  It is used to
    convert Lisp objects, being arguments of `dbus-call-method' or
@@ -463,6 +463,7 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object)
       CHECK_CONS (object);
 
       elt = XD_NEXT_VALUE (elt);
+      CHECK_CONS (elt);
       subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
       xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
 
@@ -474,11 +475,12 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object)
       break;
 
     case DBUS_TYPE_STRUCT:
-      /* A struct list might contain any number of elements with
-        different types.  No further check needed.  */
+      /* A struct list might contain any (but zero) number of elements
+        with different types.  No further check needed.  */
       CHECK_CONS (object);
 
       elt = XD_NEXT_VALUE (elt);
+      CHECK_CONS (elt);
 
       /* Compose the signature from the elements.  It is enclosed by
         parentheses.  */
@@ -509,6 +511,7 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object)
 
       /* First element.  */
       elt = XD_NEXT_VALUE (elt);
+      CHECK_CONS (elt);
       subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
       xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
       xd_signature_cat (signature, x);
@@ -518,6 +521,7 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object)
 
       /* Second element.  */
       elt = CDR_SAFE (XD_NEXT_VALUE (elt));
+      CHECK_CONS (elt);
       subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
       xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
       xd_signature_cat (signature, x);
@@ -1227,7 +1231,7 @@ this connection to those buses.  */)
                                                xd_add_watch,
                                                xd_remove_watch,
                                                xd_toggle_watch,
-                                               SYMBOLP (bus)
+                                               Fkeywordp (bus)
                                                ? (void *) XSYMBOL (bus)
                                                : (void *) XSTRING (bus),
                                                NULL))
@@ -1793,7 +1797,7 @@ xd_read_queued_messages (int fd, void *data)
     while (!NILP (busp))
       {
        key = CAR_SAFE (CAR_SAFE (busp));
-       if ((SYMBOLP (key) && XSYMBOL (key) == data)
+       if ((Fkeywordp (key) && XSYMBOL (key) == data)
            || (STRINGP (key) && XSTRING (key) == data))
          bus = key;
        busp = CDR_SAFE (busp);

diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el
index 6c77f60ec90ede6a19d6128a6b28649196a81f9f..759cd102892953939b0955270fe8f4be855f9a1d 100644 (file)
--- a/test/lisp/net/dbus-tests.el
+++ b/test/lisp/net/dbus-tests.el
@@ -366,11 +366,11 @@
   (should
    (dbus-check-arguments
     :session dbus--test-service '(:variant (:array "string"))))
-  ;; No or more than one element.
-  ;; FIXME.
-  ;; (should-error
-  ;;  (dbus-check-arguments :session dbus--test-service '(:variant))
-  ;;  :type 'wrong-type-argument)
+  ;; Empty variant.
+  (should-error
+   (dbus-check-arguments :session dbus--test-service '(:variant))
+   :type 'wrong-type-argument)
+  ;; More than one element.
   (should-error
    (dbus-check-arguments
     :session dbus--test-service
@@ -382,20 +382,22 @@
   (should
    (dbus-check-arguments
     :session dbus--test-service
-    '(:array (:dict-entry :string "string" :boolean t))))
+    '(:array (:dict-entry :string "string" :boolean nil))))
   ;; This is an alternative syntax.  FIXME: Shall this be supported?
   (should
    (dbus-check-arguments
     :session dbus--test-service
     '(:array :dict-entry (:string "string" :boolean t))))
-  ;; FIXME: Must be errors.
-  ;; (should
-  ;;  (dbus-check-arguments
-  ;;   :session dbus--test-service '(:array (:dict-entry))))
-  ;; (should
-  ;;  (dbus-check-arguments
-  ;;   :session dbus--test-service '(:array (:dict-entry :string "string"))))
-  ;; Not two elements.
+  ;; Empty dict-entry.
+  (should-error
+   (dbus-check-arguments
+    :session dbus--test-service '(:array (:dict-entry)))
+   :type 'wrong-type-argument)
+  ;; One element.
+  (should-error
+   (dbus-check-arguments
+    :session dbus--test-service '(:array (:dict-entry :string "string")))
+   :type 'wrong-type-argument)
   (should-error
    (dbus-check-arguments
     :session dbus--test-service
@@ -412,25 +414,27 @@
    (dbus-check-arguments
     :session dbus--test-service '(:dict-entry :string "string" :boolean t))
    :type 'wrong-type-argument)
-  ;; FIXME:! This doesn't look right.
-  ;; Different dict entry types can be part of an array ???
-  (should
-   (dbus-check-arguments
-    :session dbus--test-service
-    '(:array
-      (:dict-entry :string "string1" :boolean t)
-      (:dict-entry :string "string2" :object-path "/object/path"))))
+  ;; Different dict entry types are not ched.  FIXME: Add check.
+  ;; (should-error
+  ;;  (dbus-check-arguments
+  ;;   :session dbus--test-service
+  ;;   '(:array
+  ;;     (:dict-entry :string "string1" :boolean t)
+  ;;     (:dict-entry :string "string2" :object-path "/object/path")))
+  ;;  :type 'wrong-type-argument)
 
   ;; `:struct'.  There is no restriction what could be an element of a struct.
-  ;; Empty struct.  FIXME: Is this right?
-  ;; (should (dbus-check-arguments :session dbus--test-service '(:struct)))
   (should
    (dbus-check-arguments
     :session dbus--test-service
     '(:struct
       :string "string"
       :object-path "/object/path"
-      (:variant (:array :unix-fd 1 :unix-fd 2 :unix-fd 3 :unix-fd 4))))))
+      (:variant (:array :unix-fd 1 :unix-fd 2 :unix-fd 3 :unix-fd 4)))))
+  ;; Empty struct.
+  (should-error
+   (dbus-check-arguments :session dbus--test-service '(:struct))
+   :type 'wrong-type-argument))
 
 (defun dbus--test-register-service (bus)
   "Check service registration at BUS."