unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
From: Hugh Daschbach <hugh@ccss.com>
To: Michael Albinus <michael.albinus@gmx.de>
Cc: 43252@debbugs.gnu.org
Subject: bug#43252: 27.1; DBus properties lack type hints or overrides
Date: Mon, 21 Sep 2020 20:48:58 -0700	[thread overview]
Message-ID: <87zh5i8o9h.fsf@ccss.com> (raw)
In-Reply-To: <87imc7jqms.fsf@gmx.de>

[-- Attachment #1: Type: text/plain, Size: 943 bytes --]


Michael Albinus writes:

> Hi Hugh,
>
> just FTR, I have added test cases dbus-test01-basic-types and
> dbus-test01-compound-types. They use the recently added function
> dbus-check-arguments, which generates a new D-Bus message, but 
> without
> sending it. As side effect, we get errors from dbusbind.c in 
> case of.
>
> Best regards, Michael.

Thanks for the heads up.  I noticed the error messages.  Happy to 
ignore
them.

I have attached two patches for your review.  I think the property 
tests
are complete; I've adjusted the tests to expect errors on register 
or
set rather than get.  The other patch is my first draft for 
testing
introspection.

I could dig deeper into the dbus-introspect-get-interface, but 
wanted to
come up for air first.  Let me know if you think it's worth the 
effort
given the individual method, signal, and property tests.

And, of course, let me know what you think should be reworked.

Thanks,
Hugh



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Candidate patch for additional property tests. --]
[-- Type: text/x-patch, Size: 10309 bytes --]

From f3f1f07d94676a22842b04a050231639edf2ec29 Mon Sep 17 00:00:00 2001
From: Hugh Daschbach <hdasch@fastmail.com>
Date: Thu, 17 Sep 2020 23:19:32 -0700
Subject: [PATCH 1/2] Property tests (ERT).

Add DBus tests to validate property handling.  Includes cycling
register, get, set, get, GetAll, and GetManagedObjects over
several property types.

Add tests that should fail, like setting a property with a type
different from it's type at registration time.
---
 test/lisp/net/dbus-tests.el | 271 ++++++++++++++++++++++++++++++++++++
 1 file changed, 271 insertions(+)

diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el
index 62ed3f2bfb4..993a2e3848a 100644
--- a/test/lisp/net/dbus-tests.el
+++ b/test/lisp/net/dbus-tests.el
@@ -1004,6 +1004,277 @@ dbus-test06-register-property-emits-signal
     ;; Cleanup.
     (dbus-unregister-service :session dbus--test-service)))
 
+(defsubst dbus--test-run-property-test (selector name value expected)
+  "Generate a property test: register, set, get, getall sequence.
+This is a helper function for the macro `dbus--test-property'.
+The argument SELECTOR indicates whether the test should expand to
+'dbus-register-property' (if SELECTOR is 'register) or
+`dbus-set-property' (if SELECTOR is 'set).
+The argument NAME is the property name.
+The argument VALUE is the value to register or set.
+The argument EXPECTED is a transformed VALUE representing the
+form `dbus-get-property' should return."
+  (cond
+   ((eq selector 'register)
+    (should
+     (equal
+      (dbus-register-property
+       :session dbus--test-service dbus--test-path
+       dbus--test-interface name :readwrite value)
+      `((:property :session ,dbus--test-interface ,name)
+        (,dbus--test-service ,dbus--test-path)))))
+
+   ((eq selector 'set)
+    (should
+     (equal
+      (dbus-set-property
+       :session dbus--test-service dbus--test-path
+       dbus--test-interface name value)
+      expected)))
+
+   (t (signal 'wrong-type-argument "Selector should be 'register or 'set.")))
+
+  (should
+   (equal
+    (dbus-get-property
+     :session dbus--test-service dbus--test-path
+     dbus--test-interface name)
+    expected))
+
+  (let ((result
+         (dbus-get-all-properties
+          :session dbus--test-service dbus--test-path
+          dbus--test-interface)))
+    (should (equal (cdr (assoc name result)) expected)))
+
+  (let ((result
+         (dbus-get-all-managed-objects :session dbus--test-service "/"))
+        result1)
+    (should (setq result1 (cadr (assoc dbus--test-path result))))
+    (should (setq result1 (cadr (assoc dbus--test-interface result1))))
+    (should (equal (cdr (assoc name result1)) expected))))
+
+
+(defsubst dbus--test-property (name &rest value-list)
+  "Test a DBus property named by string argument NAME.
+
+The argument VALUE-LIST is a sequence of pairs, where each pair
+represents a value form and an expected returned value form.  The
+first pair in VALUES is used for `dbus-register-property'.
+Subsequent pairs of the list are tested with
+`dbus-set-property'."
+  (let ((values (car value-list)))
+    (dbus--test-run-property-test
+     'register
+     name
+     (car values)
+     (cdr values)))
+  (dolist (values (cdr value-list))
+    (dbus--test-run-property-test
+     'set
+     name
+     (car values)
+     (cdr values))))
+
+(ert-deftest dbus-test06-test-property-types ()
+  "Check property access and mutation for an own service."
+  (skip-unless dbus--test-enabled-session-bus)
+  (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service))
+  (dbus-register-service :session dbus--test-service)
+
+  (unwind-protect
+      (progn
+        (dbus--test-property
+         "ByteArray"
+         '((:array :byte 1 :byte 2 :byte 3) . (1 2 3))
+         '((:array :byte 4 :byte 5 :byte 6) . (4 5 6)))
+
+        (dbus--test-property
+         "StringArray"
+         '((:array "one" "two" :string "three") . ("one" "two" "three"))
+         '((:array :string "four" :string "five" "six") . ("four" "five" "six")))
+
+        (dbus--test-property
+         "ObjectArray"
+         '((:array
+            :object-path "/node00"
+            :object-path "/node01"
+            :object-path "/node0/node02") .
+            ("/node00" "/node01" "/node0/node02"))
+         '((:array
+            :object-path "/node10"
+            :object-path "/node11"
+            :object-path "/node0/node12") .
+            ("/node10" "/node11" "/node0/node12")))
+
+        (dbus--test-property
+         "Dictionary"
+         '((:array
+            :dict-entry (:string "four" (:variant :string "value of four"))
+            :dict-entry ("five" (:variant :object-path "/nodex"))
+            :dict-entry ("six"  (:variant (:array :byte 4 :byte 5 :byte 6)))) .
+            (("four"
+              ("value of four"))
+             ("five"
+              ("/nodex"))
+             ("six"
+              ((4 5 6)))))
+         '((:array
+            :dict-entry (:string "key0"  (:variant (:array :byte 7 :byte 8 :byte 9)))
+            :dict-entry ("key1" (:variant :string "value"))
+            :dict-entry ("key2" (:variant :object-path "/node0/node1"))) .
+            (("key0"
+              ((7 8 9)))
+             ("key1"
+              ("value"))
+             ("key2"
+              ("/node0/node1")))))
+
+        (dbus--test-property
+         "ByteDictionary"
+         '((:array
+            (:dict-entry :byte 8 (:variant :string "byte-eight"))
+            (:dict-entry :byte 16 (:variant :object-path "/byte/sixteen"))
+            (:dict-entry :byte 48 (:variant (:array :byte 8 :byte 9 :byte 10)))) .
+            ((8 ("byte-eight"))
+             (16 ("/byte/sixteen"))
+             (48 ((8 9 10))))))
+
+        (dbus--test-property
+         "Variant"
+         '((:variant "Variant string") . ("Variant string"))
+         '((:variant :byte 42) . (42))
+         '((:variant :uint32 1000000) . (1000000))
+         '((:variant :object-path "/variant/path") . ("/variant/path"))
+         '((:variant :signature "a{sa{sv}}") . ("a{sa{sv}}"))
+         '((:variant (:struct 42 "string" (:object-path "/structure/path") (:variant "last"))) .
+           ((42 "string"  ("/structure/path") ("last")))))
+
+        ;; Test that :read prevents writes
+
+        (should
+         (equal
+          (dbus-register-property
+           :session dbus--test-service dbus--test-path
+           dbus--test-interface "StringArray" :read
+           '(:array "one" "two" :string "three"))
+          `((:property :session ,dbus--test-interface "StringArray")
+	    (,dbus--test-service ,dbus--test-path))))
+
+        (should-error                   ; Cannot set property with :read access
+         (equal
+          (dbus-set-property
+           :session dbus--test-service dbus--test-path
+           dbus--test-interface "StringArray"
+           '(:array "seven" "eight" :string "nine"))
+          nil))
+
+        (should-not
+         (equal
+          (dbus-get-property
+           :session dbus--test-service dbus--test-path
+           dbus--test-interface "StringArray")
+          '("seven" "eight" "nine")))
+
+        (should                             ; Verify property has registered value
+         (equal
+          (dbus-get-property
+           :session dbus--test-service dbus--test-path
+           dbus--test-interface "StringArray")
+          '("one" "two" "three")))
+
+        ;; Test mismatched types in array
+
+        (should-error
+         (equal
+          (dbus-register-property
+           :session dbus--test-service dbus--test-path
+           dbus--test-interface "MixedArray" :readwrite
+           '(:array
+             :object-path "/node00"
+             :string "/node01"
+             :object-path "/node0/node02"))
+          `((:property :session ,dbus--test-interface "MixedArray")
+	    (,dbus--test-service ,dbus--test-path))))
+
+        ;; Test integer overflow
+
+        (should
+         (equal
+          (dbus-register-property
+           :session dbus--test-service dbus--test-path
+           dbus--test-interface "ByteValue" :readwrite
+           :byte 128)
+          `((:property :session ,dbus--test-interface "ByteValue")
+	    (,dbus--test-service ,dbus--test-path))))
+
+        (should
+         (=
+          (dbus-get-property
+           :session dbus--test-service dbus--test-path
+           dbus--test-interface "ByteValue")
+          128))
+
+        (should                             ; dbus-set-property may change property type
+         (=
+          (dbus-set-property
+           :session dbus--test-service dbus--test-path
+           dbus--test-interface "ByteValue" 1024)
+          1024))
+
+        (should
+         (=
+          (dbus-get-property
+           :session dbus--test-service dbus--test-path
+           dbus--test-interface "ByteValue")
+          1024))
+
+        (should
+         (=
+          (dbus-set-property
+           :session dbus--test-service dbus--test-path
+           dbus--test-interface "ByteValue" :byte 520)
+          8))
+
+        (should
+         (=
+          (dbus-get-property
+           :session dbus--test-service dbus--test-path
+           dbus--test-interface "ByteValue")
+          8))
+
+        (should                         ; Another change property type
+         (equal
+          (dbus-set-property
+           :session dbus--test-service dbus--test-path
+           dbus--test-interface "ByteValue" :boolean t)
+          t))
+
+        (should
+         (eq
+          (dbus-get-property
+           :session dbus--test-service dbus--test-path
+           dbus--test-interface "ByteValue")
+          t))
+
+        ;; Test invalid type specification
+
+        (should-error
+         (equal
+          (dbus-register-property
+           :session dbus--test-service dbus--test-path
+           dbus--test-interface "InvalidType" :readwrite
+           :keyword 128)
+          `((:property :session ,dbus--test-interface "InvalidType")
+	    (,dbus--test-service ,dbus--test-path)))))
+
+
+    ;; Cleanup.
+
+
+    (message "cleanup")
+    (dbus-unregister-service :session dbus--test-service)))
+
 (defun dbus-test-all (&optional interactive)
   "Run all tests for \\[dbus]."
   (interactive "p")
-- 
2.28.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: First cut approximation of Introspection tests. --]
[-- Type: text/x-patch, Size: 14700 bytes --]

From 41ad18f0094740220d5df62c656dc09cf4c18c97 Mon Sep 17 00:00:00 2001
From: Hugh Daschbach <hdasch@fastmail.com>
Date: Mon, 21 Sep 2020 17:12:49 -0700
Subject: [PATCH 2/2] Draft introspection tests.

Define an Introspection interface.  Then use dbus-introspect-*
methods to examine and verify the elements of the interface.
---
 test/lisp/net/dbus-tests.el | 362 ++++++++++++++++++++++++++++++++++++
 1 file changed, 362 insertions(+)

diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el
index 993a2e3848a..e047dcc5fae 100644
--- a/test/lisp/net/dbus-tests.el
+++ b/test/lisp/net/dbus-tests.el
@@ -1275,6 +1275,368 @@ dbus-test06-test-property-types
     (message "cleanup")
     (dbus-unregister-service :session dbus--test-service)))
 
+(defun dbus--test-introspect ()
+  "Return test introspection string."
+  "<?xml version=\"1.0\"?>
+<!DOCTYPE node PUBLIC \"-//freedesktop//DTD D-BUS Object Introspection 1.0//EN\" \"http://www.freedesktop.org/standards/dbus/1.0/introspect.dtd\">
+<node>
+  <interface name=\"org.freedesktop.DBus.Introspectable\">
+    <method name=\"Introspect\">
+      <arg name=\"xml\" type=\"s\" direction=\"out\"/>
+    </method>
+  </interface>
+  <interface name=\"org.freedesktop.DBus.Properties\">
+    <method name=\"Get\">
+      <arg name=\"interface\" type=\"s\" direction=\"in\"/>
+      <arg name=\"name\" type=\"s\" direction=\"in\"/>
+      <arg name=\"value\" type=\"v\" direction=\"out\"/>
+    </method>
+    <method name=\"Set\">
+      <arg name=\"interface\" type=\"s\" direction=\"in\"/>
+      <arg name=\"name\" type=\"s\" direction=\"in\"/>
+      <arg name=\"value\" type=\"v\" direction=\"in\"/>
+    </method>
+    <method name=\"GetAll\">
+      <arg name=\"interface\" type=\"s\" direction=\"in\"/>
+      <arg name=\"properties\" type=\"a{sv}\" direction=\"out\"/>
+    </method>
+    <signal name=\"PropertiesChanged\">
+      <arg name=\"interface\" type=\"s\"/>
+      <arg name=\"changed_properties\" type=\"a{sv}\"/>
+      <arg name=\"invalidated_properties\" type=\"as\"/>
+    </signal>
+  </interface>
+  <interface name=\"org.gnu.Emacs.TestDBus.Interface\">
+    <method name=\"Connect\">
+      <arg name=\"uuid\" type=\"s\" direction=\"in\"/>
+      <arg name=\"mode\" type=\"y\" direction=\"in\"/>
+      <arg name=\"options\" type=\"a{sv}\" direction=\"in\"/>
+      <arg name=\"interface\" type=\"s\" direction=\"out\"/>
+    </method>
+    <method name=\"DeprecatedMethod0\">
+      <annotation name=\"org.freedesktop.DBus.Deprecated\" value=\"true\"/>
+    </method>
+    <method name=\"DeprecatedMethod1\">
+      <annotation name=\"org.freedesktop.DBus.Deprecated\" value=\"true\"/>
+    </method>
+    <property name=\"Connected\" type=\"b\" access=\"read\"/>
+    <property name=\"Player\" type=\"o\" access=\"read\"/>
+    <annotation name=\"org.freedesktop.DBus.Deprecated\" value=\"true\"/>
+  </interface>
+  <node name=\"node0\"/>
+  <node name=\"node1\"/>
+</node>
+")
+
+(defsubst dbus--test-examine-interface (iface-name
+                                        expected-properties
+                                        expected-methods
+                                        expected-signals
+                                        expected-annotations)
+  "Validate an interface definition for `dbus-test-07-test-introspection'.
+The argument IFACE-NAME is a string naming the interface to validate.
+The arguments EXPECTED-PROPERTIES, EXPECTED-METHODS, EXPECTED-SIGNALS, and
+EXPECTED-ANNOTATIONS represent the names of the interface's properties,
+methods, signals, and annotations, respecively."
+
+  (let ((interface (dbus-introspect-get-interface
+                    :session
+                    dbus--test-service
+                    dbus--test-path
+                    iface-name)))
+    (pcase-let ((`(interface ((name . ,name)) . ,rest) interface))
+      (should
+       (string-equal name iface-name))
+      (should
+       (string-equal name (dbus-introspect-get-attribute interface "name")))
+
+      (let (properties methods signals annotations)
+        (mapc (lambda (x)
+                (let ((name (dbus-introspect-get-attribute x "name")))
+                  (cond
+                   ((eq 'property (car x))   (push name properties))
+                   ((eq 'method (car x))     (push name methods))
+                   ((eq 'signal (car x))     (push name signals))
+                   ((eq 'annotation (car x)) (push name annotations)))))
+              rest)
+
+        (should
+         (equal
+          (nreverse properties)
+          expected-properties))
+        (should
+         (equal
+          (nreverse methods)
+          expected-methods))
+        (should
+         (equal
+          (nreverse signals)
+          expected-signals))
+        (should
+         (equal
+          (nreverse annotations)
+          expected-annotations)))))
+  ;; should we examine method and signal arguments here as well?
+  ;; or is it sufficient to test arguments from dbus-introspect-get-(method|signal)?
+  )
+
+(defsubst dbus--test-validate-annotations (annotations expected-annotations)
+  "Validate a list of DBus ANNOTATIONS.
+Ensure each string in EXPECTED-ANNOTATIONS names an element of ANNOTATIONS.
+And ensure each ANNOTATIONS has a value attribute marked \"true\"."
+  (mapc
+   (lambda (annotation)
+     (let ((name (dbus-introspect-get-attribute annotation "name"))
+           (value (dbus-introspect-get-attribute annotation "value")))
+       (should
+        (member name expected-annotations))
+       (should
+        (equal value "true"))))
+   annotations))
+
+(defsubst dbus--test-examine-property (interface
+                                       property-name
+                                       expected-annotations
+                                       &rest expected-args)
+  "Validate a property definition for `dbus-test-07-test-introspection'.
+
+The argument INTERFACE is a string naming the interface owning PROPERTY-NAME.
+The argument PROPERTY-NAME is a string naming the property to validate.
+The arguments EXPECTED-ANNOTATIONS represent the names of the property's properties.
+The argument EXPECTED-ARGS is a list of expected arguments for the property."
+  (let* ((property (dbus-introspect-get-property
+                    :session
+                    dbus--test-service
+                    dbus--test-path
+                    interface
+                    property-name))
+         (name (dbus-introspect-get-attribute property "name"))
+         (type (dbus-introspect-get-attribute property "type"))
+         (access (dbus-introspect-get-attribute property "access"))
+         (expected (assoc-string name expected-args)))
+    (should-not (equal expected nil))
+
+    (should
+     (string-equal name property-name))
+
+    (should
+     (string-equal
+      (nth 0 expected)
+      name))
+
+    (should
+     (string-equal
+      (nth 1 expected)
+      type))
+
+    (should
+     (string-equal
+      (nth 2 expected)
+      access))))
+
+(defsubst dbus--test-validate-m-or-s (tree expected-annotations expected-args)
+  "Validate a method or signal definition for `dbus-test-07-test-introspection'.
+The argument TREE is an sexp returned from either `dbus-introspect-get-method'
+or `dbus-introspect-get-signal'
+The arguments EXPECTED-ANNOTATIONS is an sexp matching the annotations defined
+for the method or signal.
+The argument EXPECTED-ARGS is a list of expected arguments for
+the method or signal."
+  (let (args annotations)
+    (mapc (lambda (elem)
+            (let ((name (dbus-introspect-get-attribute elem "name")))
+              (cond
+               ((eq 'arg (car elem))   (push elem args))
+               ((eq 'annotation (car elem)) (push elem annotations)))))
+          tree)
+    (should
+     (equal
+      (nreverse args)
+      expected-args))
+    (dbus--test-validate-annotations annotations expected-annotations)))
+
+(defsubst dbus--test-examine-signal (interface
+                                     signal-name
+                                     expected-annotations
+                                     &rest expected-args)
+  "Validate a signal definition for `dbus-test-07-test-introspection'.
+
+The argument INTERFACE is a string naming the interface owning SIGNAL-NAME.
+The argument SIGNAL-NAME is a string naming the signal to validate.
+The arguments EXPECTED-ANNOTATIONS represent the names of the signal's properties.
+The argument EXPECTED-ARGS is a list of expected arguments for the signal."
+  (let ((signal (dbus-introspect-get-signal
+                 :session
+                 dbus--test-service
+                 dbus--test-path
+                 interface
+                 signal-name)))
+    (pcase-let ((`(signal ((name . ,name)) . ,rest) signal))
+      (should
+       (string-equal name signal-name))
+      (should
+       (string-equal name (dbus-introspect-get-attribute signal "name")))
+      (dbus--test-validate-m-or-s rest expected-annotations expected-args))))
+
+
+(defsubst dbus--test-examine-method (interface
+                                     method-name
+                                     expected-annotations
+                                     &rest expected-args)
+  "Validate a method definition for `dbus-test-07-test-introspection'.
+
+The argument INTERFACE is a string naming the interface owning METHOD-NAME.
+The argument METHOD-NAME is a string naming the method to validate.
+The arguments EXPECTED-ANNOTATIONS represent the names of the method's properties.
+The argument EXPECTED-ARGS is a list of expected arguments for the method."
+  (let ((method (dbus-introspect-get-method
+                 :session
+                 dbus--test-service
+                 dbus--test-path
+                 interface
+                 method-name)))
+    (pcase-let ((`(method ((name . ,name)) . ,rest) method))
+      (should
+       (string-equal name method-name))
+      (should
+       (string-equal name (dbus-introspect-get-attribute method "name")))
+      (dbus--test-validate-m-or-s rest expected-annotations expected-args))))
+
+(ert-deftest dbus-test07-test-introspection ()
+  "Register an Introspection interface then query it."
+  (skip-unless dbus--test-enabled-session-bus)
+  (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service))
+  (dbus-register-service :session dbus--test-service)
+
+  ;; Prepare introspections response
+  (dbus-register-method :session dbus--test-service
+                        dbus--test-path
+                        dbus-interface-introspectable
+                        "Introspect"
+                        'dbus--test-introspect)
+
+  (unwind-protect
+      ;; dbus-introspect-get-node-names
+      (should
+       (equal
+        (dbus-introspect-get-node-names :session dbus--test-service dbus--test-path)
+        '("node0" "node1")))
+
+    ;; dbus-introspect-get-all-nodes
+
+    (should
+     (equal
+      (dbus-introspect-get-all-nodes :session dbus--test-service dbus--test-path)
+      (list dbus--test-path (concat dbus--test-path "/node0") (concat dbus--test-path "/node1"))))
+
+    ;; dbus-introspect-get-interface-names
+
+    (let ((interfaces (dbus-introspect-get-interface-names
+                       :session
+                       dbus--test-service
+                       dbus--test-path)))
+
+      (should
+       (equal
+        interfaces
+        `(,dbus-interface-introspectable
+          ,dbus-interface-properties
+          ,dbus--test-interface)))
+
+      (dbus--test-examine-interface
+       dbus-interface-introspectable
+       nil
+       '("Introspect")
+       nil
+       nil)
+
+      ;; dbus-introspect-get-interface via `dbus--test-examine-interface'
+      (dbus--test-examine-interface
+       dbus-interface-properties
+       nil '("Get" "Set" "GetAll") '("PropertiesChanged") nil)
+
+      (dbus--test-examine-interface
+       dbus--test-interface
+       '("Connected" "Player")
+       '("Connect" "DeprecatedMethod0" "DeprecatedMethod1")
+       nil
+       '("org.freedesktop.DBus.Deprecated")))
+
+    ;; dbus-introspect-get-method-names
+
+    (let ((methods (dbus-introspect-get-method-names
+                    :session
+                    dbus--test-service
+                    dbus--test-path
+                    dbus--test-interface)))
+      (should
+       (equal
+        methods
+        '("Connect" "DeprecatedMethod0" "DeprecatedMethod1")))
+
+      ;; dbus-introspect-get-method via 'dbus--test-examine-method
+      (dbus--test-examine-method
+       dbus--test-interface
+       "Connect"
+       nil
+       '(arg ((name . "uuid")      (type . "s")     (direction . "in")))
+       '(arg ((name . "mode")      (type . "y")     (direction . "in")))
+       '(arg ((name . "options")   (type . "a{sv}") (direction . "in")))
+       '(arg ((name . "interface") (type . "s")     (direction . "out"))))
+
+      (dbus--test-examine-method
+       dbus--test-interface
+       "DeprecatedMethod0"
+       '("org.freedesktop.DBus.Deprecated"))
+
+      (dbus--test-examine-method
+       dbus--test-interface
+       "DeprecatedMethod1"
+       '("org.freedesktop.DBus.Deprecated")))
+
+    ;; dbus-introspect-get-signal-names
+
+    (let ((signals (dbus-introspect-get-signal-names
+                    :session
+                    dbus--test-service
+                    dbus--test-path
+                    dbus-interface-properties)))
+      (should
+       (equal
+        signals
+        '("PropertiesChanged")))
+
+      ;; dbus-introspect-get-signal via 'dbus--test-examine-signal
+      (dbus--test-examine-signal
+       dbus-interface-properties
+       "PropertiesChanged"
+       nil
+       '(arg ((name . "interface")      (type . "s")))
+       '(arg ((name . "changed_properties")      (type . "a{sv}")))
+       '(arg ((name . "invalidated_properties")   (type . "as")))))
+
+    ;; dbus-intropct-get-property-names
+
+    (let ((properties (dbus-introspect-get-property-names
+                       :session
+                       dbus--test-service
+                       dbus--test-path
+                       dbus--test-interface)))
+      (should
+       (equal
+        properties
+        '("Connected" "Player")))
+
+      ;; dbus-introspect-get-property via 'dbus--test-examine-property
+      (dbus--test-examine-property
+       dbus--test-interface
+       "Connected"
+       nil
+       '("Connected" "b" "read")
+       '("Player" "o" "read"))))
+
+  (dbus-unregister-service :session dbus--test-service))
+
 (defun dbus-test-all (&optional interactive)
   "Run all tests for \\[dbus]."
   (interactive "p")
-- 
2.28.0


  reply	other threads:[~2020-09-22  3:48 UTC|newest]

Thread overview: 52+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2020-09-07  0:54 bug#43252: 27.1; DBus properties lack type hints or overrides Hugh Daschbach
2020-09-07  7:48 ` Michael Albinus
2020-09-07 17:35   ` Hugh Daschbach
2020-09-07 18:00     ` Michael Albinus
2020-09-07 19:18       ` Hugh Daschbach
2020-09-08 14:36         ` Michael Albinus
2020-09-09  4:10           ` Hugh Daschbach
2020-09-09  4:25             ` Hugh Daschbach
2020-09-09 13:25             ` Michael Albinus
2020-09-09 16:12               ` Hugh Daschbach
2020-09-09 17:43                 ` Michael Albinus
     [not found]                 ` <874ko6979w.fsf@gmx.de>
     [not found]                   ` <87v9gm9x9i.fsf@ccss.com>
2020-09-10 14:59                     ` Michael Albinus
2020-09-10 16:57                       ` Michael Albinus
2020-09-10 19:09                         ` Hugh Daschbach
2020-09-11  8:46                           ` Michael Albinus
2020-09-10 22:53                         ` Hugh Daschbach
2020-09-11  9:57                           ` Michael Albinus
2020-09-11 14:19                           ` Michael Albinus
2020-09-15  4:05                             ` Hugh Daschbach
2020-09-16 12:47                               ` Michael Albinus
2020-09-16 22:23                                 ` Hugh Daschbach
2020-09-17 12:58                                   ` Michael Albinus
2020-09-17 18:42                                     ` Hugh Daschbach
2020-09-18  6:28                                       ` Hugh Daschbach
2020-09-18  9:55                                         ` Michael Albinus
2020-09-18 13:42                                         ` Michael Albinus
2020-09-18 15:50                                           ` Michael Albinus
2020-09-18  9:36                                       ` Michael Albinus
2020-09-19  3:32                                         ` Hugh Daschbach
2020-09-20 15:05                                           ` Michael Albinus
2020-09-21 11:50                                             ` Michael Albinus
2020-09-22  3:48                                               ` Hugh Daschbach [this message]
2020-09-22 16:09                                                 ` Michael Albinus
2020-09-22 17:36                                                 ` Michael Albinus
2020-09-23  3:30                                                   ` Hugh Daschbach
2020-09-23  3:34                                                     ` Hugh Daschbach
2020-09-23  7:44                                                     ` Michael Albinus
2020-09-23 17:32                                                     ` Michael Albinus
2020-09-24  3:02                                                       ` Hugh Daschbach
2020-09-24  8:48                                                         ` Michael Albinus
2020-09-25  4:16                                                           ` Hugh Daschbach
2020-09-26  1:27                                                             ` Hugh Daschbach
2020-09-26  9:51                                                               ` Michael Albinus
2020-09-28  3:00                                                                 ` Hugh Daschbach
2020-09-28 12:55                                                                   ` Michael Albinus
2020-09-28 23:17                                                                     ` Hugh Daschbach
2020-09-29 12:22                                                                       ` Michael Albinus
2020-09-29 21:51                                                                         ` Hugh Daschbach
2020-09-30  9:34                                                                           ` Michael Albinus
2020-09-30 10:42                                                                             ` Michael Albinus
2020-09-30 16:39                                                                               ` Hugh Daschbach
2020-09-10  8:00 ` bug#43252: Fwd: " Michael Albinus

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=87zh5i8o9h.fsf@ccss.com \
    --to=hugh@ccss.com \
    --cc=43252@debbugs.gnu.org \
    --cc=michael.albinus@gmx.de \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).