master 63f9d9a: Add D-Bus tests

[Michael Albinus]

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

    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 c317e5d..95d6523 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 458ee81..86db7cb 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 eb883e5..4c5ab48 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 b12b027..58ad051 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.