From: Hugh Daschbach <hugh@ccss.com>
To: Michael Albinus <michael.albinus@gmx.de>
Cc: Hugh Daschbach <hugh@ccss.com>,
44298@debbugs.gnu.org, 44298+DONE@debbugs.gnu.org
Subject: bug#44298: 28.0.50; D-Bus GetManagedObjects doesn't enumerate all paths.
Date: Thu, 29 Oct 2020 20:03:51 -0700 [thread overview]
Message-ID: <87o8kke7oo.fsf@ccss.com> (raw)
In-Reply-To: <87d0113twf.fsf@gmx.de>
[-- Attachment #1: Type: text/plain, Size: 553 bytes --]
Michael Albinus writes:
>> If a D-Bus interface is registered on more than one path, processing an
>> incoming GetManagedObjects method call only reports a single path.
>
> Thanks for the report! I've pushed a fix to master, which should solve it.
Michael, many thanks. That fixes the issue. I've extended the test to
cover multiple interfaces and multiple paths. I've attached a patch if
you're interested.
I've tried to follow your advice on closing the bug. If I missed the
mark, please feel free to close it yourself.
Thanks again,
Hugh
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Extend GetManagedObjects test. --]
[-- Type: text/x-patch, Size: 7172 bytes --]
From 1b2e74b26ebd925539a07b909cfd600a66c4ab82 Mon Sep 17 00:00:00 2001
From: Hugh Daschbach <hdasch@fastmail.com>
Date: Thu, 29 Oct 2020 19:46:26 -0700
Subject: [PATCH] Extend GetManagedObjects test.
* test/lisp/net/dbus-tests.el (dbus-test09-get-managed-objects): Expand test.
---
test/lisp/net/dbus-tests.el | 128 +++++++++++++++++++++---------------
1 file changed, 76 insertions(+), 52 deletions(-)
diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el
index d630f80706e..6363ca2aebe 100644
--- a/test/lisp/net/dbus-tests.el
+++ b/test/lisp/net/dbus-tests.el
@@ -1890,78 +1890,102 @@ dbus-test08-register-monitor
(ert-deftest dbus-test09-get-managed-objects ()
"Check `dbus-get-all-managed-objects'."
- :tags '(:expensive-test)
(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
- (let ((path1 (concat dbus--test-path "/path1"))
- (path2 (concat dbus--test-path "/path2"))
- (path3 (concat dbus--test-path "/path3")))
+ (let ((interfaces
+ `((,(concat dbus--test-interface ".I0")
+ ((,(concat dbus--test-path "/obj1")
+ (("I0Property1" . "Zero one one")
+ ("I0Property2" . "Zero one two")
+ ("I0Property3" . "Zero one three")))
+ (,(concat dbus--test-path "/obj0/obj2")
+ (("I0Property1" . "Zero two one")
+ ("I0Property2" . "Zero two two")
+ ("I0Property3" . "Zero two three")))
+ (,(concat dbus--test-path "/obj0/obj3")
+ (("I0Property1" . "Zero three one")
+ ("I0Property2" . "Zero three two")
+ ("I0Property3" . "Zero three three")))))
+ (,(concat dbus--test-interface ".I1")
+ ((,(concat dbus--test-path "/obj0/obj2")
+ (("I1Property1" . "One one one")
+ ("I1Property2" . "One one two")))
+ (,(concat dbus--test-path "/obj0/obj3")
+ (("I1Property1" . "One two one")
+ ("I1Property2" . "One two two"))))))))
(should-not
(dbus-get-all-managed-objects
:session dbus--test-service dbus--test-path))
- (should
- (equal
- (dbus-register-property
- :session dbus--test-service path1 dbus--test-interface
- "Property1" :readwrite "Simple string one.")
- `((:property :session ,dbus--test-interface "Property1")
- (,dbus--test-service ,path1))))
-
- (should
- (equal
- (dbus-register-property
- :session dbus--test-service path2 dbus--test-interface
- "Property1" :readwrite "Simple string two.")
- `((:property :session ,dbus--test-interface "Property1")
- (,dbus--test-service ,path2))))
-
- (should
- (equal
- (dbus-register-property
- :session dbus--test-service path3 dbus--test-interface
- "Property1" :readwrite "Simple string three.")
- `((:property :session ,dbus--test-interface "Property1")
- (,dbus--test-service ,path3))))
-
- (should
- (equal
- (dbus-get-property
- :session dbus--test-service path1 dbus--test-interface
- "Property1")
- "Simple string one."))
-
- (should
- (equal
- (dbus-get-property
- :session dbus--test-service path2 dbus--test-interface
- "Property1")
- "Simple string two."))
-
- (should
- (equal
- (dbus-get-property
- :session dbus--test-service path3 dbus--test-interface
- "Property1")
- "Simple string three."))
+ (dolist (interface interfaces)
+ (pcase-let ((`(,iname ,objs) interface))
+ (dolist (obj objs)
+ (pcase-let ((`(,path ,props) obj))
+ (dolist (prop props)
+ (should
+ (equal
+ (dbus-register-property
+ :session dbus--test-service path iname
+ (car prop) :readwrite (cdr prop))
+ `((:property :session ,iname ,(car prop))
+ (,dbus--test-service ,path)))))))))
(let ((result (dbus-get-all-managed-objects
:session dbus--test-service dbus--test-path)))
(should
(= 3 (length result)))
- (should
- (assoc-string path1 result))
+ (dolist (interface interfaces)
+ (pcase-let ((`(,iname ,objs) interface))
+ (dolist (obj objs)
+ (pcase-let ((`(,path ,props) obj))
+ (let* ((object (cadr (assoc-string path result)))
+ (iface (cadr (assoc-string iname object))))
+ (should object)
+ (should iface)
+ (dolist (prop props)
+ (should (equal (cdr (assoc-string (car prop) iface))
+ (cdr prop))))))))))
+ (let ((result (dbus-get-all-managed-objects
+ :session dbus--test-service (concat dbus--test-path "/obj0"))))
(should
- (assoc-string path2 result))
+ (= 2 (length result)))
+
+ (dolist (interface interfaces)
+ (pcase-let ((`(,iname ,objs) interface))
+ (dolist (obj objs)
+ (pcase-let ((`(,path ,props) obj))
+ (when (string-prefix-p (concat dbus--test-path "/obj0/") path)
+ (let* ((object (cadr (assoc-string path result)))
+ (iface (cadr (assoc-string iname object))))
+ (should object)
+ (should iface)
+ (dolist (prop props)
+ (should (equal (cdr (assoc-string (car prop) iface))
+ (cdr prop)))))))))))
+ (let ((result (dbus-get-all-managed-objects
+ :session dbus--test-service (concat dbus--test-path "/obj0/obj2"))))
(should
- (assoc-string path3 result))))
+ (= 1 (length result)))
+
+ (dolist (interface interfaces)
+ (pcase-let ((`(,iname ,objs) interface))
+ (dolist (obj objs)
+ (pcase-let ((`(,path ,props) obj))
+ (when (string-prefix-p (concat dbus--test-path "/obj0/obj2") path)
+ (let* ((object (cadr (assoc-string path result)))
+ (iface (cadr (assoc-string iname object))))
+ (should object)
+ (should iface)
+ (dolist (prop props)
+ (should (equal (cdr (assoc-string (car prop) iface))
+ (cdr prop))))))))))))
;; Cleanup.
(dbus-unregister-service :session dbus--test-service)))
--
2.28.0
next prev parent reply other threads:[~2020-10-30 3:03 UTC|newest]
Thread overview: 5+ messages / expand[flat|nested] mbox.gz Atom feed top
2020-10-29 2:55 bug#44298: 28.0.50; D-Bus GetManagedObjects doesn't enumerate all paths Hugh Daschbach
2020-10-29 15:59 ` Michael Albinus
2020-10-30 3:03 ` Hugh Daschbach [this message]
2020-10-30 8:07 ` Michael Albinus
2020-10-30 3:21 ` bug#44298: Resolved Hugh Daschbach
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=87o8kke7oo.fsf@ccss.com \
--to=hugh@ccss.com \
--cc=44298+DONE@debbugs.gnu.org \
--cc=44298@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).