From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Hugh Daschbach Newsgroups: gmane.emacs.bugs Subject: bug#43252: 27.1; DBus properties lack type hints or overrides Date: Mon, 21 Sep 2020 20:48:58 -0700 Message-ID: <87zh5i8o9h.fsf@ccss.com> References: <87v9gqquct.fsf@ccss.com> <87pn6xqtsz.fsf@ccss.com> <87363sl4hs.fsf@gmx.de> <877dt3bnfl.fsf@ccss.com> <878sdj84kn.fsf@gmx.de> <871rjbaq05.fsf@ccss.com> <874ko6979w.fsf@gmx.de> <87v9gm9x9i.fsf@ccss.com> <871rj9k78r.fsf@gmx.de> <87imclwow5.fsf@gmx.de> <87pn6t9rbq.fsf@ccss.com> <87y2lggzvd.fsf@gmx.de> <87h7rzadlo.fsf@ccss.com> <87k0wtrir2.fsf@gmx.de> <87een19x9n.fsf@ccss.com> <87a6xor25b.fsf@gmx.de> <87bli49rem.fsf@ccss.com> <87h7rva0ku.fsf@gmx.de> <875z8aa1bm.fsf@ccss.com> <87ft7c8p4k.fsf@gmx.de> <87imc7jqms.fsf@gmx.de> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="10962"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: mu4e 1.5.5; emacs 27.1 Cc: 43252@debbugs.gnu.org To: Michael Albinus Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Tue Sep 22 05:50:14 2020 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1kKZJl-0002hg-4S for geb-bug-gnu-emacs@m.gmane-mx.org; Tue, 22 Sep 2020 05:50:13 +0200 Original-Received: from localhost ([::1]:39848 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1kKZJk-0001SS-4J for geb-bug-gnu-emacs@m.gmane-mx.org; Mon, 21 Sep 2020 23:50:12 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:57222) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1kKZJa-0001SK-HD for bug-gnu-emacs@gnu.org; Mon, 21 Sep 2020 23:50:02 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]:45310) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1kKZJa-0007h0-7Q for bug-gnu-emacs@gnu.org; Mon, 21 Sep 2020 23:50:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1kKZJa-0003ap-4d for bug-gnu-emacs@gnu.org; Mon, 21 Sep 2020 23:50:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Hugh Daschbach Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Tue, 22 Sep 2020 03:50:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 43252 X-GNU-PR-Package: emacs Original-Received: via spool by 43252-submit@debbugs.gnu.org id=B43252.160074655513752 (code B ref 43252); Tue, 22 Sep 2020 03:50:02 +0000 Original-Received: (at 43252) by debbugs.gnu.org; 22 Sep 2020 03:49:15 +0000 Original-Received: from localhost ([127.0.0.1]:56856 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1kKZIo-0003Zj-8c for submit@debbugs.gnu.org; Mon, 21 Sep 2020 23:49:15 -0400 Original-Received: from mail1.ccss.com ([159.203.255.73]:59216) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1kKZIk-0003ZS-3H for 43252@debbugs.gnu.org; Mon, 21 Sep 2020 23:49:13 -0400 Original-Received: by mail1.ccss.com (Postfix, from userid 114) id 213E8BF881; Mon, 21 Sep 2020 20:49:04 -0700 (PDT) Original-Received: from ccss.com (unknown [192.168.76.11]) by mail1.ccss.com (Postfix) with ESMTP id 8C2AABF87C; Mon, 21 Sep 2020 20:49:02 -0700 (PDT) Original-Received: from localhost (localhost [127.0.0.1]) by ccss.com (Postfix) with ESMTP id 6501D1761272; Mon, 21 Sep 2020 20:49:02 -0700 (PDT) Original-Received: from ccss.com ([127.0.0.1]) by localhost (ccss.com [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id YFEkyGwiScPx; Mon, 21 Sep 2020 20:48:59 -0700 (PDT) Original-Received: from klaatu (klaatu.lan [192.168.42.3]) (Authenticated sender: hugh) by ccss.com (Postfix) with ESMTPSA id 45E0A176064A; Mon, 21 Sep 2020 20:48:59 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=ccss.com; s=mail; t=1600746539; bh=E20j0byldW9USvFrGOSrvpwfLgLkouds1byvhsR3UBc=; h=References:From:To:Cc:Subject:In-reply-to:Date:From; b=eV3TNdSQCBSUfWjpJdpMTDEDF4BRoiL9P41MQt5KvYsaTQHGJO1etoroPXalu9k5+ aAmvTGRTa9xEZfcC+N/kZIokao6sWDZpn3kvhgvQ4NbdPmeqUIDM0AFSROG8M+YG2v u9i+k84vKH7PQlPWBuvQeywdxmgNTlq7NJF8HAp02ic5CN6BRJGmj1Yszd5oapz8Oo Au4KeIJQFzwGIVvqnKHfKNQjqmbTB+vqW/y3810XPFfBhFRCOjGb3U7rsPInqpmdbg ZtT34qSESTgdIEPCtEDIPdARLPr4UxgXL6p9tIVbzaYMG2JS4CFd8DOykcgn5j/Gi4 a+FUWos300gLw== In-reply-to: <87imc7jqms.fsf@gmx.de> X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.io gmane.emacs.bugs:188657 Archived-At: --=-=-= Content-Type: text/plain; format=flowed 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Property-tests-ERT.patch Content-Description: Candidate patch for additional property tests. >From f3f1f07d94676a22842b04a050231639edf2ec29 Mon Sep 17 00:00:00 2001 From: Hugh Daschbach 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-Draft-introspection-tests.patch Content-Description: First cut approximation of Introspection tests. >From 41ad18f0094740220d5df62c656dc09cf4c18c97 Mon Sep 17 00:00:00 2001 From: Hugh Daschbach 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." + " + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +") + +(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 --=-=-=--