>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