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: Thu, 17 Sep 2020 23:28:34 -0700 Message-ID: <878sd7a99p.fsf@ccss.com> References: <87v9gqquct.fsf@ccss.com> <87imcqdo38.fsf@gmx.de> <87sgbtqylc.fsf@ccss.com> <87sgbtcvqs.fsf@gmx.de> <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> 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="40355"; 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 Fri Sep 18 08:29:16 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 1kJ9tT-000ANm-La for geb-bug-gnu-emacs@m.gmane-mx.org; Fri, 18 Sep 2020 08:29:15 +0200 Original-Received: from localhost ([::1]:48708 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1kJ9tS-0002YV-O3 for geb-bug-gnu-emacs@m.gmane-mx.org; Fri, 18 Sep 2020 02:29:14 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:50102) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1kJ9tG-0002Ws-71 for bug-gnu-emacs@gnu.org; Fri, 18 Sep 2020 02:29:02 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]:57136) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1kJ9tF-0004WF-UO for bug-gnu-emacs@gnu.org; Fri, 18 Sep 2020 02:29:01 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1kJ9tF-0004D1-Qa for bug-gnu-emacs@gnu.org; Fri, 18 Sep 2020 02:29:01 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Hugh Daschbach Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Fri, 18 Sep 2020 06:29:01 +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.160041052716158 (code B ref 43252); Fri, 18 Sep 2020 06:29:01 +0000 Original-Received: (at 43252) by debbugs.gnu.org; 18 Sep 2020 06:28:47 +0000 Original-Received: from localhost ([127.0.0.1]:40449 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1kJ9t0-0004CV-Oh for submit@debbugs.gnu.org; Fri, 18 Sep 2020 02:28:47 -0400 Original-Received: from mail1.ccss.com ([159.203.255.73]:53326) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1kJ9sy-0004CI-9n for 43252@debbugs.gnu.org; Fri, 18 Sep 2020 02:28:45 -0400 Original-Received: by mail1.ccss.com (Postfix, from userid 114) id 7F16DBF8CE; Thu, 17 Sep 2020 23:28:38 -0700 (PDT) Original-Received: from ccss.com (unknown [192.168.76.11]) by mail1.ccss.com (Postfix) with ESMTP id 39432BF8C0; Thu, 17 Sep 2020 23:28:37 -0700 (PDT) Original-Received: from localhost (localhost [127.0.0.1]) by ccss.com (Postfix) with ESMTP id 09A9A17605D8; Thu, 17 Sep 2020 23:28:37 -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 bFp1SySRN_nM; Thu, 17 Sep 2020 23:28:35 -0700 (PDT) Original-Received: from klaatu (klaatu.lan [192.168.42.3]) (Authenticated sender: hugh) by ccss.com (Postfix) with ESMTPSA id D8DA417605AB; Thu, 17 Sep 2020 23:28:34 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=ccss.com; s=mail; t=1600410514; bh=Dk+dQxEsNTDsgTe/i89CMnEjQdi+Gzp5A4BETyxKYkc=; h=References:From:To:Cc:Subject:In-reply-to:Date:From; b=VFR8/wVl8jEcSoNgkh9JzPKacfb09TrgC1976tolu9dyWF1fXtsn20bhJ41JbH3LG ZMjIjqHDVALxW++G7q5ot+1TERou9rUZC7ehPLv5oFzxWR18n+y49VLDf2oBLpZq2u kNzxq2zXvTHOD0Rl0dGPoDqkvgixCvxVLhsq6Q1L5v2HIazuuoewa9GCuGtlYXBXHS G2CEh/9kHTofcl5FJi2oa37WdtHpW4xk3TlvMZzey+6W17DQNRLahCXX49r3GLZK9t oC7lZSHQcInNGYfDOKTL7QrXp+iW+9Vi6gsYvv1jsnVI42trr2UjYV8MNG5DbIvmrd KlC1sbPaUqnkg== In-reply-to: <87bli49rem.fsf@ccss.com> 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:188265 Archived-At: --=-=-= Content-Type: text/plain; format=flowed Hugh Daschbach writes: > Michael Albinus writes: > >> Hugh Daschbach writes: >> >> Hi Hugh, >> > I need more testing and a cleanup pass. I'll pass along a > better > version when > I think it's ready for review. > > I've started a few "should fail" tests. I've made a bit of progress. I have a few tests that fail. There doesn't seem to be any type checking on property set. But have a look and see if you concur that these are real errors. I've attached a patch. In addition, I see a failure in dbus-test04-register-method: > F dbus-test04-register-method > Check method registration for an own service. > (ert-test-failed > ((should > (equal > (should-error > (dbus-call-method :session dbus--test-service > dbus--test-path dbus--test-interface method1 :timeout 10 "foo")) > `(dbus-error ... "The name is not activatable"))) > :form > (equal > (dbus-error "org.freedesktop.DBus.Error.ServiceUnknown" > "The name org.gnu.Emacs.TestDBus was not provided by any > .service files") > (dbus-error "org.freedesktop.DBus.Error.ServiceUnknown" > "The name is not activatable")) > :value nil :explanation > (list-elt 2 > (arrays-of-different-length 70 27 "The name > org.gnu.Emacs.TestDBus was not provided by any .service files" > "The name is not activatable" first-mismatch-at 9)))) > Your mileage may vary. I'm starting to run out of ideas for additional tests. Suggestions welcome. Cheers, Hugh --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Property-tests-ERT.patch Content-Description: Additional property tests. >From 722852e9e1d402742508233051951d21b02bc3c9 Mon Sep 17 00:00:00 2001 From: Hugh Daschbach Date: Thu, 17 Sep 2020 23:19:32 -0700 Subject: [PATCH] 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 | 319 ++++++++++++++++++++++++++++++++++++ 1 file changed, 319 insertions(+) diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el index 18c2a2ad6d2..682aaa8325a 100644 --- a/test/lisp/net/dbus-tests.el +++ b/test/lisp/net/dbus-tests.el @@ -755,6 +755,325 @@ dbus-test06-register-property-emits-signal ;; Cleanup. (dbus-unregister-service :session dbus--test-service))) +(defun dbus-test06-make-property-test (selector name value expected) + "Generate a property test: register, set, get, getall sequence. +This is a helper function for the macro +`dbus-test06-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." + +;; Since we don't expect this helper function and it's caller +;; `dbus-test06-make-property' to be used outside this file, we don't +;; bother with `eval-and-compile.' It would be appropriate to wrap +;; this with `eval-and-compile' if that expectation is misguided. + + `(progn + ,(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)))) ) + + +(defmacro dbus-test06-test-property (name value-list) + "Generate a DBus property test. +The argument NAME is a property name for the test. + +The argument VALUES is a list 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 (gensym)) + (value (gensym)) + (expected (gensym)) + (pair (gensym)) + (first (gensym))) + (let ((values value-list)) + (append + `(progn) + (list + (dbus-test06-make-property-test + 'register + name + `',(caar values) + `',(cdar values))) + (mapcar (lambda (pair) + (dbus-test06-make-property-test + 'set + name + `',(car pair) + `',(cdr pair) + )) + (cdr values)))))) + +(defmacro with-dbus-monitor (buffer &rest body) + "Run BODY in an environment that captures `dbus-monitor' output in BUFFER." + (declare (indent defun)) + `(let ((process + (start-process "dbus-monitor" ,buffer + "dbus-monitor" + "--session" + (concat "sender=" dbus--test-service) + (concat "destination=" dbus--test-service)))) + (unwind-protect + (progn ,@body) + (sit-for 0.5) + (delete-process process)))) + +(ert-deftest dbus-test06-test-property-types () + "Check property type preservation 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 + (with-dbus-monitor "*dbus-monitor*" + (progn + (dbus-test06-test-property + "ByteArray" + (((:array :byte 1 :byte 2 :byte 3) . (1 2 3)) + ((:array :byte 4 :byte 5 :byte 6) . (4 5 6)))) + + (dbus-test06-test-property + "StringArray" + (((:array "one" "two" :string "three") . ("one" "two" "three")) + ((:array :string "four" :string "five" "six") . ("four" "five" "six")))) + + (dbus-test06-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-test06-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-test06-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-test06-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 "/org/gnu/Emacs/TestDBus")))) + + (should ; Should this error instead? + (equal + (dbus-set-property + :session dbus--test-service dbus--test-path + dbus--test-interface "StringArray" + '(:array "seven" "eight" :string "nine")) + nil)) + + (should-not ; Not update by dbus-set-property + (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 ; Oddly enough, register works, but get fails + (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 "/org/gnu/Emacs/TestDBus")))) + + (should-error + (equal + (dbus-get-property + :session dbus--test-service dbus--test-path + dbus--test-interface "MixedArray") + '("/node00" "/node01" "/node0/node02"))) + + ;; 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 "/org/gnu/Emacs/TestDBus")))) + + (should + (= + (dbus-get-property + :session dbus--test-service dbus--test-path + dbus--test-interface "ByteValue") + 128)) + + (should ; This should error or the next get should fail + (equal + (dbus-set-property + :session dbus--test-service dbus--test-path + dbus--test-interface "ByteValue" 1024) + 1024)) + + + (should-not ; This should fail or the preceeding set should error + (= + (dbus-get-property + :session dbus--test-service dbus--test-path + dbus--test-interface "ByteValue") + 1024)) + + (should + (= + (dbus-get-property + :session dbus--test-service dbus--test-path + dbus--test-interface "ByteValue") + 128)) + + ;; Test set with invalid type + + (should ; No error, but the invalid type throws an error on get + (equal + (dbus-set-property + :session dbus--test-service dbus--test-path + dbus--test-interface "ByteValue" :boolean t) nil)) + + (should-not + (eq + (dbus-get-property + :session dbus--test-service dbus--test-path + dbus--test-interface "ByteValue") + t)) + + (should + (= + (dbus-get-property + :session dbus--test-service dbus--test-path + dbus--test-interface "ByteValue") + 128)) + + ;; Test invalid type specification + + (should + (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 "/org/gnu/Emacs/TestDBus")))) + + (should-error + (= + (dbus-get-property + :session dbus--test-service dbus--test-path + dbus--test-interface "InvalidType") + 128))) + + + ;; 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 --=-=-=--