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

[Michael Albinus]

branch: master
commit 0a5a1adab986de39a147771b8f9aa21656ecc001
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>

    * src/dbusbind.c (xd_signature): Better type check for array elements.
    
    * test/lisp/net/dbus-tests.el (dbus-test01-compound-types): Extend test.
---
 src/dbusbind.c              | 10 ++++++++--
 test/lisp/net/dbus-tests.el | 41 ++++++++++++++++++++++++++++++-----------
 2 files changed, 38 insertions(+), 13 deletions(-)

diff --git a/src/dbusbind.c b/src/dbusbind.c
index 1ac7731..7904606 100644
--- 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 94816bb..cd2e166 100644
--- 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)