From 63f9d9af81a2758bfb3699ce223d9cbf891257d6 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 21 Sep 2020 13:41:30 +0200 Subject: [PATCH] Add D-Bus tests * doc/misc/dbus.texi (Type Conversion): Precise basic type values. * lisp/net/dbus.el (dbus-register-property): Send signal directly. * src/dbusbind.c (xd_signature): Accept non-nil objects for DBUS_TYPE_BOOLEAN. * test/lisp/net/dbus-tests.el (dbus-test01-basic-types) (dbus-test01-compound-types): New tests. --- doc/misc/dbus.texi | 19 +-- lisp/net/dbus.el | 21 +-- src/dbusbind.c | 4 +- test/lisp/net/dbus-tests.el | 269 ++++++++++++++++++++++++++++++++++++ 4 files changed, 294 insertions(+), 19 deletions(-) diff --git a/doc/misc/dbus.texi b/doc/misc/dbus.texi index c317e5dd23d..95d6523d36d 100644 --- a/doc/misc/dbus.texi +++ b/doc/misc/dbus.texi @@ -1025,15 +1025,16 @@ but different to (dbus-call-method @dots{} :int32 @var{nat-number} :signature @var{string}) @end lisp -The value for a byte D-Bus type can be any integer in the range 0 -through 255. If a character is used as argument, modifiers -represented outside this range are stripped off. For example, -@code{:byte ?x} is equal to @code{:byte ?\M-x}, but it is not equal to -@code{:byte ?\C-x} or @code{:byte ?\M-\C-x}. Signed and unsigned -integer D-Bus types expect a corresponding integer value. - -All basic D-Bus types based on a number are truncated to their type -range. For example, @code{:byte 1025} is equal to @code{:byte 1}. +The value for a D-Bus byte type can be any natural number. If the +number is larger than 255, it is truncated to the least significant +byte. For example, @code{:byte 1025} is equal to @code{:byte 1}. If +a character is used as argument, modifiers represented outside this +range are stripped off. For example, @code{:byte ?x} is equal to +@code{:byte ?\M-x}, but it is not equal to @code{:byte ?\C-x} or +@code{:byte ?\M-\C-x}. + +Signed and unsigned D-Bus integer types expect a corresponding integer +value. A unix file descriptor is restricted to the values 0@dots{}9. If typed explicitly, a non-@code{nil} boolean value like @code{:boolean 'symbol} is handled like @code{t} or @code{:boolean t}. diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index 458ee81d70f..86db7cbf18a 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -1660,6 +1660,19 @@ clients from discovering the still incomplete interface. (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" + ;; changed_properties. + (if (eq access :write) + '(:array: :signature "{sv}") + `(:array (:dict-entry ,property ,value))) + ;; invalidated_properties. + (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)) @@ -1670,14 +1683,6 @@ clients from discovering the still incomplete interface. bus service path interface property)))) (puthash key val dbus-registered-objects-table) - ;; Set or Get the property, in order to validate the property's - ;; value and to send the PropertiesChanged signal. - (when (member service (dbus-list-names bus)) - (if (eq access :read) - (dbus-get-property bus service path interface property) - (apply - #'dbus-set-property bus service path interface property (cdr value)))) - ;; Return the object. (list key (list service path))))) diff --git a/src/dbusbind.c b/src/dbusbind.c index eb883e5dc83..4c5ab485803 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -374,8 +374,8 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object) break; case DBUS_TYPE_BOOLEAN: - if (!EQ (object, Qt) && !NILP (object)) - wrong_type_argument (intern ("booleanp"), object); + /* Any non-nil object will be regarded as `t', so we don't apply + further type check. */ sprintf (signature, "%c", dtype); break; diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el index b12b02771ad..58ad0516c56 100644 --- a/test/lisp/net/dbus-tests.el +++ b/test/lisp/net/dbus-tests.el @@ -91,6 +91,275 @@ (string-equal (dbus-unescape-from-identifier (dbus-escape-as-identifier mstr)) mstr)))) +(ert-deftest dbus-test01-basic-types () + "Check basic D-Bus type arguments." + ;; Unknown keyword. + (should-error + (dbus-check-arguments :session dbus--test-service :keyword) + :type 'wrong-type-argument) + + ;; `:string'. + (should (dbus-check-arguments :session dbus--test-service "string")) + (should (dbus-check-arguments :session dbus--test-service :string "string")) + (should-error + (dbus-check-arguments :session dbus--test-service :string 0.5) + :type 'wrong-type-argument) + + ;; `:object-path'. + (should + (dbus-check-arguments + :session dbus--test-service :object-path "/object/path")) + (should-error + (dbus-check-arguments :session dbus--test-service :object-path "string") + :type 'dbus-error) + (should-error + (dbus-check-arguments :session dbus--test-service :object-path 0.5) + :type 'wrong-type-argument) + + ;; `:signature'. + (should (dbus-check-arguments :session dbus--test-service :signature "as")) + (should-error + (dbus-check-arguments :session dbus--test-service :signature "string") + :type 'dbus-error) + (should-error + (dbus-check-arguments :session dbus--test-service :signature 0.5) + :type 'wrong-type-argument) + + ;; `:boolean'. + (should (dbus-check-arguments :session dbus--test-service nil)) + (should (dbus-check-arguments :session dbus--test-service t)) + (should (dbus-check-arguments :session dbus--test-service :boolean nil)) + (should (dbus-check-arguments :session dbus--test-service :boolean t)) + ;; Will be handled as `nil'. + (should (dbus-check-arguments :session dbus--test-service :boolean)) + ;; Will be handled as `t'. + (should (dbus-check-arguments :session dbus--test-service :boolean 'whatever)) + + ;; `:byte'. + (should (dbus-check-arguments :session dbus--test-service :byte 0)) + ;; Only the least significant byte is taken into account. + (should + (dbus-check-arguments :session dbus--test-service :byte most-positive-fixnum)) + (should-error + (dbus-check-arguments :session dbus--test-service :byte -1) + :type 'wrong-type-argument) + (should-error + (dbus-check-arguments :session dbus--test-service :byte 0.5) + :type 'wrong-type-argument) + (should-error + (dbus-check-arguments :session dbus--test-service :byte "string") + :type 'wrong-type-argument) + + ;; `:int16'. + (should (dbus-check-arguments :session dbus--test-service :int16 0)) + (should (dbus-check-arguments :session dbus--test-service :int16 #x7fff)) + (should (dbus-check-arguments :session dbus--test-service :int16 #x-8000)) + (should-error + (dbus-check-arguments :session dbus--test-service :int16 #x8000) + :type 'args-out-of-range) + (should-error + (dbus-check-arguments :session dbus--test-service :int16 #x-8001) + :type 'args-out-of-range) + (should-error + (dbus-check-arguments :session dbus--test-service :int16 0.5) + :type 'wrong-type-argument) + (should-error + (dbus-check-arguments :session dbus--test-service :int16 "string") + :type 'wrong-type-argument) + + ;; `:uint16'. + (should (dbus-check-arguments :session dbus--test-service :uint16 0)) + (should (dbus-check-arguments :session dbus--test-service :uint16 #xffff)) + (should-error + (dbus-check-arguments :session dbus--test-service :uint16 #x10000) + :type 'args-out-of-range) + (should-error + (dbus-check-arguments :session dbus--test-service :uint16 -1) + :type 'wrong-type-argument) + (should-error + (dbus-check-arguments :session dbus--test-service :uint16 0.5) + :type 'wrong-type-argument) + (should-error + (dbus-check-arguments :session dbus--test-service :uint16 "string") + :type 'wrong-type-argument) + + ;; `:int32'. + (should (dbus-check-arguments :session dbus--test-service :int32 0)) + (should (dbus-check-arguments :session dbus--test-service :int32 #x7fffffff)) + (should (dbus-check-arguments :session dbus--test-service :int32 #x-80000000)) + (should-error + (dbus-check-arguments :session dbus--test-service :int32 #x80000000) + :type 'args-out-of-range) + (should-error + (dbus-check-arguments :session dbus--test-service :int32 #x-80000001) + :type 'args-out-of-range) + (should-error + (dbus-check-arguments :session dbus--test-service :int32 0.5) + :type 'args-out-of-range) + (should-error + (dbus-check-arguments :session dbus--test-service :int32 "string") + :type 'wrong-type-argument) + + ;; `:uint32'. + (should (dbus-check-arguments :session dbus--test-service 0)) + (should (dbus-check-arguments :session dbus--test-service :uint32 0)) + (should (dbus-check-arguments :session dbus--test-service :uint32 #xffffffff)) + (should-error + (dbus-check-arguments :session dbus--test-service :uint32 #x100000000) + :type 'args-out-of-range) + (should-error + (dbus-check-arguments :session dbus--test-service :uint32 -1) + :type 'args-out-of-range) + (should-error + (dbus-check-arguments :session dbus--test-service :uint32 0.5) + :type 'args-out-of-range) + (should-error + (dbus-check-arguments :session dbus--test-service :uint32 "string") + :type 'wrong-type-argument) + + ;; `:int64'. + (should (dbus-check-arguments :session dbus--test-service :int64 0)) + (should + (dbus-check-arguments :session dbus--test-service :int64 #x7fffffffffffffff)) + (should + (dbus-check-arguments :session dbus--test-service :int64 #x-8000000000000000)) + (should-error + (dbus-check-arguments :session dbus--test-service :int64 #x8000000000000000) + :type 'args-out-of-range) + (should-error + (dbus-check-arguments :session dbus--test-service :int64 #x-8000000000000001) + :type 'args-out-of-range) + (should-error + (dbus-check-arguments :session dbus--test-service :int64 0.5) + :type 'args-out-of-range) + (should-error + (dbus-check-arguments :session dbus--test-service :int64 "string") + :type 'wrong-type-argument) + + ;; `:uint64'. + (should (dbus-check-arguments :session dbus--test-service :uint64 0)) + (should + (dbus-check-arguments :session dbus--test-service :uint64 #xffffffffffffffff)) + (should-error + (dbus-check-arguments :session dbus--test-service :uint64 #x10000000000000000) + :type 'args-out-of-range) + (should-error + (dbus-check-arguments :session dbus--test-service :uint64 -1) + :type 'args-out-of-range) + (should-error + (dbus-check-arguments :session dbus--test-service :uint64 0.5) + :type 'args-out-of-range) + (should-error + (dbus-check-arguments :session dbus--test-service :uint64 "string") + :type 'wrong-type-argument) + + ;; `:double'. + (should (dbus-check-arguments :session dbus--test-service :double 0)) + (should (dbus-check-arguments :session dbus--test-service :double 0.5)) + (should (dbus-check-arguments :session dbus--test-service :double -0.5)) + (should (dbus-check-arguments :session dbus--test-service :double -1)) + ;; Shall both be supported? + (should (dbus-check-arguments :session dbus--test-service :double 1.0e+INF)) + (should (dbus-check-arguments :session dbus--test-service :double 0.0e+NaN)) + (should-error + (dbus-check-arguments :session dbus--test-service :double "string") + :type 'wrong-type-argument) + + ;; `:unix-fd'. Value range 0 .. 9. + (should (dbus-check-arguments :session dbus--test-service :unix-fd 0)) + (should (dbus-check-arguments :session dbus--test-service :unix-fd 9)) + (should-error + (dbus-check-arguments :session dbus--test-service :unix-fd 10) + :type 'dbus-error) + (should-error + (dbus-check-arguments :session dbus--test-service :unix-fd -1) + :type 'args-out-of-range) + (should-error + (dbus-check-arguments :session dbus--test-service :unix-fd 0.5) + :type 'args-out-of-range) + (should-error + (dbus-check-arguments :session dbus--test-service :unix-fd "string") + :type 'wrong-type-argument)) + +(ert-deftest dbus-test01-compound-types () + "Check basic D-Bus type arguments." + ;; `:array'. It contains several elements of the same type. + (should (dbus-check-arguments :session dbus--test-service '("string"))) + (should (dbus-check-arguments :session dbus--test-service '(:array "string"))) + (should + (dbus-check-arguments :session dbus--test-service '(:array :string "string"))) + (should + (dbus-check-arguments + :session dbus--test-service '(:array :string "string1" "string2"))) + ;; Empty array. + (should (dbus-check-arguments :session dbus--test-service '(:array))) + (should + (dbus-check-arguments :session dbus--test-service '(:array :signature "o"))) + ;; Different element types. + (should-error + (dbus-check-arguments + :session dbus--test-service + '(:array :string "string" :object-path "/object/path")) + :type 'wrong-type-argument) + + ;; `:variant'. It contains exactly one element. + (should + (dbus-check-arguments + :session dbus--test-service '(:variant :string "string"))) + (should + (dbus-check-arguments + :session dbus--test-service '(:variant (:array "string")))) + ;; More than one element. + (should-error + (dbus-check-arguments + :session dbus--test-service + '(:variant :string "string" :object-path "/object/path")) + :type 'wrong-type-argument) + + ;; `:dict-entry'. It must contain two elements; the first one must + ;; be of a basic type. It must be an element of an array. + (should + (dbus-check-arguments + :session dbus--test-service + '(:array (:dict-entry :string "string" :boolean t)))) + ;; The second element is `nil' (implicitely). FIXME: Is this right? + (should + (dbus-check-arguments + :session dbus--test-service '(:array (:dict-entry :string "string")))) + ;; Not two elements. + (should-error + (dbus-check-arguments + :session dbus--test-service + '(:array (:dict-entry :string "string" :boolean t :boolean t))) + :type 'wrong-type-argument) + ;; The first element ist not of a basic type. + (should-error + (dbus-check-arguments + :session dbus--test-service + '(:array (:dict-entry (:array :string "string") :boolean t))) + :type 'wrong-type-argument) + ;; It is not an element of an array. + (should-error + (dbus-check-arguments + :session dbus--test-service '(:dict-entry :string "string" :boolean t)) + :type 'wrong-type-argument) + ;; 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")))) + + ;; `:struct'. There is no restriction what could be an element of a 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)))))) + (defun dbus--test-register-service (bus) "Check service registration at BUS." ;; Cleanup. -- 2.39.2