* src/dbusbind.c (xd_signature): Better type check for array elements.

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

diff --git a/src/dbusbind.c b/src/dbusbind.c
index 1ac77313a35c6e96e374fcfe4af9cf7314ed2c0a..7904606d39e29948bdc6ba70d7b5d617131a7d5a 100644 (file)
--- a/src/dbusbind.c
+++ b/src/dbusbind.c
@@ -446,12 +446,18 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object)
        {
          Lisp_Object elt1 = XD_NEXT_VALUE (elt);
          if (CONSP (elt1) && STRINGP (XCAR (elt1)) && NILP (XCDR (elt1)))
-           subsig = SSDATA (XCAR (elt1));
+           {
+             subsig = SSDATA (XCAR (elt1));
+             elt = Qnil;
+           }
        }
 
       while (!NILP (elt))
        {
-         if (subtype != XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt)))
+         char x[DBUS_MAXIMUM_SIGNATURE_LENGTH];
+         subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt));
+         xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt)));
+         if (strcmp (subsig, x) != 0)
            wrong_type_argument (intern ("D-Bus"), CAR_SAFE (elt));
          elt = CDR_SAFE (XD_NEXT_VALUE (elt));
        }

diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el
index 94816bb4929778a6784bd892f60c4a2bfa050cbd..cd2e166c103b4405a68fb6f341c6fd782afd34df 100644 (file)
--- a/test/lisp/net/dbus-tests.el
+++ b/test/lisp/net/dbus-tests.el
@@ -131,7 +131,7 @@
   (should-error
    (dbus-check-arguments :session dbus--test-service :object-path)
    :type 'wrong-type-argument)
-  ;; Raises an error on stdin.
+  ;; Raises an error on stderr.
   (should-error
    (dbus-check-arguments :session dbus--test-service :object-path "string")
    :type 'dbus-error)
@@ -144,7 +144,7 @@
   (should-error
    (dbus-check-arguments :session dbus--test-service :signature)
    :type 'wrong-type-argument)
-  ;; Raises an error on stdin.
+  ;; Raises an error on stderr.
   (should-error
    (dbus-check-arguments :session dbus--test-service :signature "string")
    :type 'dbus-error)
@@ -348,8 +348,12 @@
   (should
    (dbus-check-arguments
     :session dbus--test-service '(:array :string "string1" "string2")))
+  (should
+   (dbus-check-arguments
+    :session dbus--test-service '(:array :signature "s" :signature "ao")))
   ;; Empty array (of strings).
   (should (dbus-check-arguments :session dbus--test-service '(:array)))
+  ;; Empty array (of object paths).
   (should
    (dbus-check-arguments :session dbus--test-service '(:array :signature "o")))
   ;; Different element types.
@@ -358,6 +362,13 @@
     :session dbus--test-service
     '(:array :string "string" :object-path "/object/path"))
    :type 'wrong-type-argument)
+  ;; Different variant types in array don't matter.
+  (should
+   (dbus-check-arguments
+    :session dbus--test-service
+    '(:array
+      (:variant :string "string1")
+      (:variant (:struct :string "string2" :object-path "/object/path")))))
 
   ;; `:variant'.  It contains exactly one element.
   (should
@@ -383,7 +394,7 @@
    (dbus-check-arguments
     :session dbus--test-service
     '(:array (:dict-entry :string "string" :boolean nil))))
-  ;; This is an alternative syntax.  FIXME: Shall this be supported?
+  ;; This is an alternative syntax.
   (should
    (dbus-check-arguments
     :session dbus--test-service
@@ -414,14 +425,14 @@
    (dbus-check-arguments
     :session dbus--test-service '(:dict-entry :string "string" :boolean t))
    :type 'wrong-type-argument)
-  ;; 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)
+  ;; Different dict entry types in array.
+  (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.
   (should
@@ -434,6 +445,14 @@
   ;; Empty struct.
   (should-error
    (dbus-check-arguments :session dbus--test-service '(:struct))
+   :type 'wrong-type-argument)
+  ;; Different struct types in array.
+  (should-error
+   (dbus-check-arguments
+    :session dbus--test-service
+    '(:array
+      (:struct :string "string1" :boolean t)
+      (:struct :object-path "/object/path")))
    :type 'wrong-type-argument))
 
 (defun dbus--test-register-service (bus)