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

* test/lisp/net/dbus-tests.el (dbus-test01-compound-types): Extend test.
This commit is contained in:
Michael Albinus 2020-10-05 13:58:28 +02:00
parent c47479cf17
commit 0a5a1adab9
2 changed files with 38 additions and 13 deletions

View file

@ -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));
}

View file

@ -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)