emacs/test/lisp/net/dbus-tests.el

;;; dbus-tests.el --- Tests of D-Bus integration into Emacs  -*- lexical-binding:t -*-

;; Copyright (C) 2013-2020 Free Software Foundation, Inc.

;; Author: Michael Albinus <michael.albinus@gmx.de>

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.

;;; Code:

(require 'ert)
(require 'dbus)

(defvar dbus-debug nil)
(declare-function dbus-get-unique-name "dbusbind.c" (bus))

(defconst dbus--test-enabled-session-bus
  (and (featurep 'dbusbind)
       (dbus-ignore-errors (dbus-get-unique-name :session)))
  "Check, whether we are registered at the session bus.")

(defconst dbus--test-enabled-system-bus
  (and (featurep 'dbusbind)
       (dbus-ignore-errors (dbus-get-unique-name :system)))
  "Check, whether we are registered at the system bus.")

(defconst dbus--test-service "org.gnu.Emacs.TestDBus"
  "Test service.")

(defconst dbus--test-path "/org/gnu/Emacs/TestDBus"
  "Test object path.")

(defconst dbus--test-interface "org.gnu.Emacs.TestDBus.Interface"
  "Test interface.")

(defun dbus--test-availability (bus)
  "Test availability of D-Bus BUS."
  (should (dbus-list-names bus))
  (should (dbus-list-activatable-names bus))
  (should (dbus-list-known-names bus))
  (should (dbus-get-unique-name bus)))

(ert-deftest dbus-test00-availability-session ()
  "Test availability of D-Bus `:session'."
  :expected-result (if dbus--test-enabled-session-bus :passed :failed)
  (dbus--test-availability :session))

(ert-deftest dbus-test00-availability-system ()
  "Test availability of D-Bus `:system'."
  :expected-result (if dbus--test-enabled-system-bus :passed :failed)
  (dbus--test-availability :system))

(ert-deftest dbus-test01-type-conversion ()
  "Check type conversion functions."
  (skip-unless dbus--test-enabled-session-bus)

  (let ((ustr "0123abc_xyz\x01\xff")
	(mstr "Grüß Göttin"))
    (should
     (string-equal
      (dbus-byte-array-to-string (dbus-string-to-byte-array "")) ""))
    (should
     (string-equal
      (dbus-byte-array-to-string (dbus-string-to-byte-array ustr)) ustr))
    (should
     (string-equal
      (dbus-byte-array-to-string (dbus-string-to-byte-array mstr) 'multibyte)
      mstr))
    ;; Should not work for multibyte strings.
    (should-not
     (string-equal
      (dbus-byte-array-to-string (dbus-string-to-byte-array mstr)) mstr))

    (should
     (string-equal
      (dbus-unescape-from-identifier (dbus-escape-as-identifier "")) ""))
    (should
     (string-equal
      (dbus-unescape-from-identifier (dbus-escape-as-identifier ustr)) ustr))
    ;; Should not work for multibyte strings.
    (should-not
     (string-equal
      (dbus-unescape-from-identifier (dbus-escape-as-identifier mstr)) mstr))))

(ert-deftest dbus-test01-basic-types ()
  "Check basic D-Bus type arguments."
  (skip-unless dbus--test-enabled-session-bus)

  ;; No argument or unknown keyword.
  (should-error
   (dbus-check-arguments :session dbus--test-service)
   :type 'wrong-number-of-arguments)
  (should-error
   (dbus-check-arguments :session dbus--test-service :keyword)
   :type 'wrong-type-argument)

  ;; `:string'.
  (should (dbus-check-arguments :session dbus--test-service "string"))
  (should (dbus-check-arguments :session dbus--test-service :string "string"))
  (should-error
   (dbus-check-arguments :session dbus--test-service :string)
   :type 'wrong-type-argument)
  (should-error
   (dbus-check-arguments :session dbus--test-service :string 0.5)
   :type 'wrong-type-argument)

  ;; `:object-path'.
  (should
   (dbus-check-arguments
    :session dbus--test-service :object-path "/object/path"))
  (should-error
   (dbus-check-arguments :session dbus--test-service :object-path)
   :type 'wrong-type-argument)
  ;; Raises an error on stdin.
  (should-error
   (dbus-check-arguments :session dbus--test-service :object-path "string")
   :type 'dbus-error)
  (should-error
   (dbus-check-arguments :session dbus--test-service :object-path 0.5)
   :type 'wrong-type-argument)

  ;; `:signature'.
  (should (dbus-check-arguments :session dbus--test-service :signature "as"))
  (should-error
   (dbus-check-arguments :session dbus--test-service :signature)
   :type 'wrong-type-argument)
  ;; Raises an error on stdin.
  (should-error
   (dbus-check-arguments :session dbus--test-service :signature "string")
   :type 'dbus-error)
  (should-error
   (dbus-check-arguments :session dbus--test-service :signature 0.5)
   :type 'wrong-type-argument)

  ;; `:boolean'.
  (should (dbus-check-arguments :session dbus--test-service nil))
  (should (dbus-check-arguments :session dbus--test-service t))
  (should (dbus-check-arguments :session dbus--test-service :boolean nil))
  (should (dbus-check-arguments :session dbus--test-service :boolean t))
  (should (dbus-check-arguments :session dbus--test-service :boolean 'whatever))
  (should-error
   (dbus-check-arguments :session dbus--test-service :boolean)
   :type 'wrong-type-argument)

  ;; `:byte'.
  (should (dbus-check-arguments :session dbus--test-service :byte 0))
  ;; Only the least significant byte is taken into account.
  (should
   (dbus-check-arguments :session dbus--test-service :byte most-positive-fixnum))
  (should-error
   (dbus-check-arguments :session dbus--test-service :byte)
   :type 'wrong-type-argument)
  (should-error
   (dbus-check-arguments :session dbus--test-service :byte -1)
   :type 'wrong-type-argument)
  (should-error
   (dbus-check-arguments :session dbus--test-service :byte 0.5)
   :type 'wrong-type-argument)
  (should-error
   (dbus-check-arguments :session dbus--test-service :byte "string")
   :type 'wrong-type-argument)

  ;; `:int16'.
  (should (dbus-check-arguments :session dbus--test-service :int16 0))
  (should (dbus-check-arguments :session dbus--test-service :int16 #x7fff))
  (should (dbus-check-arguments :session dbus--test-service :int16 #x-8000))
  (should-error
   (dbus-check-arguments :session dbus--test-service :int16)
   :type 'wrong-type-argument)
  (should-error
   (dbus-check-arguments :session dbus--test-service :int16 #x8000)
   :type 'args-out-of-range)
  (should-error
   (dbus-check-arguments :session dbus--test-service :int16 #x-8001)
   :type 'args-out-of-range)
  (should-error
   (dbus-check-arguments :session dbus--test-service :int16 0.5)
   :type 'wrong-type-argument)
  (should-error
   (dbus-check-arguments :session dbus--test-service :int16 "string")
   :type 'wrong-type-argument)

  ;; `:uint16'.
  (should (dbus-check-arguments :session dbus--test-service :uint16 0))
  (should (dbus-check-arguments :session dbus--test-service :uint16 #xffff))
  (should-error
   (dbus-check-arguments :session dbus--test-service :uint16)
   :type 'wrong-type-argument)
  (should-error
   (dbus-check-arguments :session dbus--test-service :uint16 #x10000)
   :type 'args-out-of-range)
  (should-error
   (dbus-check-arguments :session dbus--test-service :uint16 -1)
   :type 'wrong-type-argument)
  (should-error
   (dbus-check-arguments :session dbus--test-service :uint16 0.5)
   :type 'wrong-type-argument)
  (should-error
   (dbus-check-arguments :session dbus--test-service :uint16 "string")
   :type 'wrong-type-argument)

  ;; `:int32'.
  (should (dbus-check-arguments :session dbus--test-service :int32 0))
  (should (dbus-check-arguments :session dbus--test-service :int32 #x7fffffff))
  (should (dbus-check-arguments :session dbus--test-service :int32 #x-80000000))
  (should-error
   (dbus-check-arguments :session dbus--test-service :int32)
   :type 'wrong-type-argument)
  (should-error
   (dbus-check-arguments :session dbus--test-service :int32 #x80000000)
   :type 'args-out-of-range)
  (should-error
   (dbus-check-arguments :session dbus--test-service :int32 #x-80000001)
   :type 'args-out-of-range)
  (should-error
   (dbus-check-arguments :session dbus--test-service :int32 0.5)
   :type 'args-out-of-range)
  (should-error
   (dbus-check-arguments :session dbus--test-service :int32 "string")
   :type 'wrong-type-argument)

  ;; `:uint32'.
  (should (dbus-check-arguments :session dbus--test-service 0))
  (should (dbus-check-arguments :session dbus--test-service :uint32 0))
  (should (dbus-check-arguments :session dbus--test-service :uint32 #xffffffff))
  (should-error
   (dbus-check-arguments :session dbus--test-service :uint32)
   :type 'wrong-type-argument)
  (should-error
   (dbus-check-arguments :session dbus--test-service :uint32 #x100000000)
   :type 'args-out-of-range)
  (should-error
   (dbus-check-arguments :session dbus--test-service :uint32 -1)
   :type 'args-out-of-range)
  (should-error
   (dbus-check-arguments :session dbus--test-service :uint32 0.5)
   :type 'args-out-of-range)
  (should-error
   (dbus-check-arguments :session dbus--test-service :uint32 "string")
   :type 'wrong-type-argument)

  ;; `:int64'.
  (should (dbus-check-arguments :session dbus--test-service :int64 0))
  (should
   (dbus-check-arguments :session dbus--test-service :int64 #x7fffffffffffffff))
  (should
   (dbus-check-arguments :session dbus--test-service :int64 #x-8000000000000000))
  (should-error
   (dbus-check-arguments :session dbus--test-service :int64)
   :type 'wrong-type-argument)
  (should-error
   (dbus-check-arguments :session dbus--test-service :int64 #x8000000000000000)
   :type 'args-out-of-range)
  (should-error
   (dbus-check-arguments :session dbus--test-service :int64 #x-8000000000000001)
   :type 'args-out-of-range)
  (should-error
   (dbus-check-arguments :session dbus--test-service :int64 0.5)
   :type 'args-out-of-range)
  (should-error
   (dbus-check-arguments :session dbus--test-service :int64 "string")
   :type 'wrong-type-argument)

  ;; `:uint64'.
  (should (dbus-check-arguments :session dbus--test-service :uint64 0))
  (should
   (dbus-check-arguments :session dbus--test-service :uint64 #xffffffffffffffff))
  (should-error
   (dbus-check-arguments :session dbus--test-service :uint64)
   :type 'wrong-type-argument)
  (should-error
   (dbus-check-arguments :session dbus--test-service :uint64 #x10000000000000000)
   :type 'args-out-of-range)
  (should-error
   (dbus-check-arguments :session dbus--test-service :uint64 -1)
   :type 'args-out-of-range)
  (should-error
   (dbus-check-arguments :session dbus--test-service :uint64 0.5)
   :type 'args-out-of-range)
  (should-error
   (dbus-check-arguments :session dbus--test-service :uint64 "string")
   :type 'wrong-type-argument)

  ;; `:double'.
  (should (dbus-check-arguments :session dbus--test-service :double 0))
  (should (dbus-check-arguments :session dbus--test-service :double 0.5))
  (should (dbus-check-arguments :session dbus--test-service :double -0.5))
  (should (dbus-check-arguments :session dbus--test-service :double -1))
  ;; Shall both be supported?
  (should (dbus-check-arguments :session dbus--test-service :double 1.0e+INF))
  (should (dbus-check-arguments :session dbus--test-service :double 0.0e+NaN))
  (should-error
   (dbus-check-arguments :session dbus--test-service :double)
   :type 'wrong-type-argument)
  (should-error
   (dbus-check-arguments :session dbus--test-service :double "string")
   :type 'wrong-type-argument)

  ;; `:unix-fd'.  UNIX file descriptors are transfered out-of-band.
  ;; We do not support this, and so we cannot do much testing here for
  ;; `:unix-fd' being an argument (which is an index to the file
  ;; descriptor in the array of file descriptors that accompany the
  ;; D-Bus message).  Mainly testing, that values out of `:uint32'
  ;; type range fail.
  (should (dbus-check-arguments :session dbus--test-service :unix-fd 0))
  (should-error
   (dbus-check-arguments :session dbus--test-service :unix-fd)
   :type 'wrong-type-argument)
  (should-error
   (dbus-check-arguments :session dbus--test-service :unix-fd -1)
   :type 'args-out-of-range)
  (should-error
   (dbus-check-arguments :session dbus--test-service :unix-fd 0.5)
   :type 'args-out-of-range)
  (should-error
   (dbus-check-arguments :session dbus--test-service :unix-fd "string")
   :type 'wrong-type-argument))

(ert-deftest dbus-test01-compound-types ()
  "Check basic D-Bus type arguments."
  (skip-unless dbus--test-enabled-session-bus)

  ;; `:array'.  It contains several elements of the same type.
  (should (dbus-check-arguments :session dbus--test-service '("string")))
  (should (dbus-check-arguments :session dbus--test-service '(:array "string")))
  (should
   (dbus-check-arguments :session dbus--test-service '(:array :string "string")))
  (should
   (dbus-check-arguments
    :session dbus--test-service '(:array :string "string1" "string2")))
  ;; Empty array (of strings).
  (should (dbus-check-arguments :session dbus--test-service '(:array)))
  (should
   (dbus-check-arguments :session dbus--test-service '(:array :signature "o")))
  ;; Different element types.
  (should-error
   (dbus-check-arguments
    :session dbus--test-service
    '(:array :string "string" :object-path "/object/path"))
   :type 'wrong-type-argument)

  ;; `:variant'.  It contains exactly one element.
  (should
   (dbus-check-arguments
    :session dbus--test-service '(:variant :string "string")))
  (should
   (dbus-check-arguments
    :session dbus--test-service '(:variant (:array "string"))))
  ;; No or more than one element.
  ;; FIXME.
  ;; (should-error
  ;;  (dbus-check-arguments :session dbus--test-service '(:variant))
  ;;  :type 'wrong-type-argument)
  (should-error
   (dbus-check-arguments
    :session dbus--test-service
    '(:variant :string "string" :object-path "/object/path"))
   :type 'wrong-type-argument)

  ;; `:dict-entry'.  It must contain two elements; the first one must
  ;; be of a basic type.  It must be an element of an array.
  (should
   (dbus-check-arguments
    :session dbus--test-service
    '(:array (:dict-entry :string "string" :boolean t))))
  ;; This is an alternative syntax.  FIXME: Shall this be supported?
  (should
   (dbus-check-arguments
    :session dbus--test-service
    '(:array :dict-entry (:string "string" :boolean t))))
  ;; FIXME: Must be errors.
  ;; (should
  ;;  (dbus-check-arguments
  ;;   :session dbus--test-service '(:array (:dict-entry))))
  ;; (should
  ;;  (dbus-check-arguments
  ;;   :session dbus--test-service '(:array (:dict-entry :string "string"))))
  ;; Not two elements.
  (should-error
   (dbus-check-arguments
    :session dbus--test-service
    '(:array (:dict-entry :string "string" :boolean t :boolean t)))
   :type 'wrong-type-argument)
  ;; The first element ist not of a basic type.
  (should-error
   (dbus-check-arguments
    :session dbus--test-service
    '(:array (:dict-entry (:array :string "string") :boolean t)))
   :type 'wrong-type-argument)
  ;; It is not an element of an array.
  (should-error
   (dbus-check-arguments
    :session dbus--test-service '(:dict-entry :string "string" :boolean t))
   :type 'wrong-type-argument)
  ;; FIXME:! This doesn't look right.
  ;; Different dict entry types can be part of an array ???
  (should
   (dbus-check-arguments
    :session dbus--test-service
    '(:array
      (:dict-entry :string "string1" :boolean t)
      (:dict-entry :string "string2" :object-path "/object/path"))))

  ;; `:struct'.  There is no restriction what could be an element of a struct.
  ;; Empty struct.  FIXME: Is this right?
  ;; (should (dbus-check-arguments :session dbus--test-service '(:struct)))
  (should
   (dbus-check-arguments
    :session dbus--test-service
    '(:struct
      :string "string"
      :object-path "/object/path"
      (:variant (:array :unix-fd 1 :unix-fd 2 :unix-fd 3 :unix-fd 4))))))

(defun dbus--test-register-service (bus)
  "Check service registration at BUS."
  ;; Cleanup.
  (dbus-ignore-errors (dbus-unregister-service bus dbus--test-service))

  ;; Register an own service.
  (should (eq (dbus-register-service bus dbus--test-service) :primary-owner))
  (should (member dbus--test-service (dbus-list-known-names bus)))
  (should (eq (dbus-register-service bus dbus--test-service) :already-owner))
  (should (member dbus--test-service (dbus-list-known-names bus)))

  ;; Unregister the service.
  (should (eq (dbus-unregister-service bus dbus--test-service) :released))
  (should-not (member dbus--test-service (dbus-list-known-names bus)))
  (should (eq (dbus-unregister-service bus dbus--test-service) :non-existent))
  (should-not (member dbus--test-service (dbus-list-known-names bus)))

  ;; `dbus-service-dbus' is reserved for the BUS itself.
  (should
   (equal
    (butlast
     (should-error (dbus-register-service bus dbus-service-dbus)))
    `(dbus-error ,dbus-error-invalid-args)))
  (should
   (equal
    (butlast
     (should-error (dbus-unregister-service bus dbus-service-dbus)))
    `(dbus-error ,dbus-error-invalid-args))))

(ert-deftest dbus-test02-register-service-session ()
  "Check service registration at `:session' bus."
  (skip-unless (and dbus--test-enabled-session-bus
		    (dbus-register-service :session dbus--test-service)))
  (dbus--test-register-service :session)

  (let ((service "org.freedesktop.Notifications"))
    (when (member service (dbus-list-known-names :session))
      ;; Cleanup.
      (dbus-ignore-errors (dbus-unregister-service :session service))

      (should (eq (dbus-register-service :session service) :in-queue))
      (should (eq (dbus-unregister-service :session service) :released))

      (should
       (eq (dbus-register-service :session service :do-not-queue) :exists))
      (should (eq (dbus-unregister-service :session service) :not-owner)))))

(ert-deftest dbus-test02-register-service-system ()
  "Check service registration at `:system' bus."
  (skip-unless (and dbus--test-enabled-system-bus
		    (dbus-register-service :system dbus--test-service)))
  (dbus--test-register-service :system))

(ert-deftest dbus-test02-register-service-own-bus ()
  "Check service registration with an own bus.
This includes initialization and closing the bus."
  ;; Start bus.
  (let ((output
	 (ignore-errors
	   (shell-command-to-string "env DISPLAY= dbus-launch --sh-syntax")))
	bus pid)
    (skip-unless (stringp output))
    (when (string-match "DBUS_SESSION_BUS_ADDRESS='\\(.+\\)';" output)
      (setq bus (match-string 1 output)))
    (when (string-match "DBUS_SESSION_BUS_PID=\\([[:digit:]]+\\);" output)
      (setq pid (match-string 1 output)))
    (unwind-protect
	(progn
	  (skip-unless
	   (dbus-ignore-errors
	     (and bus pid
		  (featurep 'dbusbind)
		  (dbus-init-bus bus)
		  (dbus-get-unique-name bus)
		  (dbus-register-service bus dbus--test-service))))
	  ;; Run the test.
	  (dbus--test-register-service bus))

      ;; Save exit.
      (when pid (call-process "kill" nil nil nil pid)))))

(ert-deftest dbus-test03-peer-interface ()
  "Check `dbus-interface-peer' methods."
  (skip-unless
   (and dbus--test-enabled-session-bus
	(dbus-register-service :session dbus--test-service)
	;; "GetMachineId" is not implemented (yet).  When it returns a
	;; value, another D-Bus client like dbus-monitor is reacting
	;; on `dbus-interface-peer'.  We cannot test then.
	(not
	 (dbus-ignore-errors
	   (dbus-call-method
	    :session dbus--test-service dbus-path-dbus
	    dbus-interface-peer "GetMachineId" :timeout 100)))))

  (should (dbus-ping :session dbus--test-service 100))
  (dbus-unregister-service :session dbus--test-service)
  (should-not (dbus-ping :session dbus--test-service 100)))

(defun dbus--test-method-handler (&rest args)
  "Method handler for `dbus-test04-register-method'."
  (cond
   ;; No argument.
   ((null args)
    :ignore)
   ;; One argument.
   ((= 1 (length args))
    (car args))
   ;; Two arguments.
   ((= 2 (length args))
    `(:error ,dbus-error-invalid-args
             ,(format-message "Wrong arguments %s" args)))
   ;; More than two arguments.
   (t (signal 'dbus-error (cons "D-Bus signal" args)))))

(ert-deftest dbus-test04-register-method ()
  "Check method registration for an own service."
  (skip-unless dbus--test-enabled-session-bus)
  (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service))

  (unwind-protect
      (let ((method1 "Method1")
            (method2 "Method2")
            (handler #'dbus--test-method-handler)
            registered)

        ;; The service is not registered yet.
        (should
         (equal
          (butlast
           (should-error
            (dbus-call-method
             :session dbus--test-service dbus--test-path
             dbus--test-interface method1 :timeout 10 "foo")))
           `(dbus-error ,dbus-error-service-unknown)))

        ;; Register.
        (should
         (equal
          (setq
           registered
           (dbus-register-method
            :session dbus--test-service dbus--test-path
            dbus--test-interface method1 handler))
          `((:method :session ,dbus--test-interface ,method1)
            (,dbus--test-service ,dbus--test-path ,handler))))
        (should
         (equal
          (dbus-register-method
           :session dbus--test-service dbus--test-path
           dbus--test-interface method2 handler)
          `((:method :session ,dbus--test-interface ,method2)
            (,dbus--test-service ,dbus--test-path ,handler))))

        ;; No argument, returns nil.
        (should-not
         (dbus-call-method
          :session dbus--test-service dbus--test-path
          dbus--test-interface method1))
        ;; One argument, returns the argument.
        (should
         (string-equal
          (dbus-call-method
           :session dbus--test-service dbus--test-path
           dbus--test-interface method1 "foo")
          "foo"))
        ;; Two arguments, D-Bus error activated as `(:error ...)' list.
        (should
         (equal
          (should-error
           (dbus-call-method
            :session dbus--test-service dbus--test-path
            dbus--test-interface method1 "foo" "bar"))
          `(dbus-error ,dbus-error-invalid-args "Wrong arguments (foo bar)")))
        ;; Three arguments, D-Bus error activated by `dbus-error' signal.
        (should
         (equal
          (should-error
           (dbus-call-method
            :session dbus--test-service dbus--test-path
            dbus--test-interface method1 "foo" "bar" "baz"))
          `(dbus-error
            ,dbus-error-failed
            "D-Bus error: \"D-Bus signal\", \"foo\", \"bar\", \"baz\"")))

        ;; Unregister method.
        (should (dbus-unregister-object registered))
        (should-not (dbus-unregister-object registered))
        (should
         (equal
          (butlast
           (should-error
            (dbus-call-method
             :session dbus--test-service dbus--test-path
             dbus--test-interface method1 :timeout 10 "foo")))
          `(dbus-error ,dbus-error-no-reply))))

    ;; Cleanup.
    (dbus-unregister-service :session dbus--test-service)))

(defvar dbus--test-signal-received nil
  "Received signal value in `dbus--test-signal-handler'.")

(defun dbus--test-signal-handler (&rest args)
  "Signal handler for `dbus-test*-signal'."
  (setq dbus--test-signal-received args))

(defun dbus--test-timeout-handler (&rest _ignore)
  "Timeout handler, reporting a failed test."
  (ert-fail (format "`%s' timed out" (ert-test-name (ert-running-test)))))

(ert-deftest dbus-test05-register-signal ()
  "Check signal registration for an own service."
  (skip-unless dbus--test-enabled-session-bus)
  (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service))

  (unwind-protect
      (let ((member "Member")
            (handler #'dbus--test-signal-handler)
            registered)

        ;; Register signal handler.
        (should
         (equal
          (setq
           registered
           (dbus-register-signal
            :session dbus--test-service dbus--test-path
            dbus--test-interface member handler))
          `((:signal :session ,dbus--test-interface ,member)
            (,dbus--test-service ,dbus--test-path ,handler))))

        ;; Send one argument, basic type.
        (setq dbus--test-signal-received nil)
        (dbus-send-signal
         :session dbus--test-service dbus--test-path
         dbus--test-interface member "foo")
	(with-timeout (1 (dbus--test-timeout-handler))
          (while (null dbus--test-signal-received)
            (read-event nil nil 0.1)))
        (should (equal dbus--test-signal-received '("foo")))

        ;; Send two arguments, compound types.
        (setq dbus--test-signal-received nil)
        (dbus-send-signal
         :session dbus--test-service dbus--test-path
         dbus--test-interface member
         '(:array :byte 1 :byte 2 :byte 3) '(:variant :string "bar"))
	(with-timeout (1 (dbus--test-timeout-handler))
          (while (null dbus--test-signal-received)
            (read-event nil nil 0.1)))
        (should (equal dbus--test-signal-received '((1 2 3) ("bar"))))

        ;; Unregister signal.
        (should (dbus-unregister-object registered))
        (should-not (dbus-unregister-object registered)))

    ;; Cleanup.
    (dbus-unregister-service :session dbus--test-service)))

(ert-deftest dbus-test06-register-property ()
  "Check property registration for an own service."
  (skip-unless dbus--test-enabled-session-bus)
  (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service))

  (unwind-protect
      (let ((property1 "Property1")
            (property2 "Property2")
            (property3 "Property3")
            (property4 "Property4")
            registered)

        ;; `:read' property.
        (should
         (equal
          (setq
           registered
           (dbus-register-property
            :session dbus--test-service dbus--test-path
            dbus--test-interface property1 :read "foo"))
          `((:property :session ,dbus--test-interface ,property1)
            (,dbus--test-service ,dbus--test-path))))
        (should
         (string-equal
          (dbus-get-property
           :session dbus--test-service dbus--test-path
           dbus--test-interface property1)
          "foo"))
        ;; Due to `:read' access type, we don't get a proper reply
        ;; from `dbus-set-property'.
        (should
         (equal
          (butlast
           (should-error
            (dbus-set-property
             :session dbus--test-service dbus--test-path
             dbus--test-interface property1 "foofoo")))
          `(dbus-error ,dbus-error-property-read-only)))
        (should
         (string-equal
          (dbus-get-property
           :session dbus--test-service dbus--test-path
           dbus--test-interface property1)
          "foo"))

        ;; `:write' property.
        (should
         (equal
          (dbus-register-property
           :session dbus--test-service dbus--test-path
           dbus--test-interface property2 :write "bar")
          `((:property :session ,dbus--test-interface ,property2)
            (,dbus--test-service ,dbus--test-path))))
        ;; Due to `:write' access type, we don't get a proper reply
        ;; from `dbus-get-property'.
        (should
         (equal
          (butlast
           (should-error
            (dbus-get-property
             :session dbus--test-service dbus--test-path
             dbus--test-interface property2)))
          `(dbus-error ,dbus-error-access-denied)))
        (should
         (string-equal
          (dbus-set-property
           :session dbus--test-service dbus--test-path
           dbus--test-interface property2 "barbar")
          "barbar"))
        ;; Still `:write' access type.
        (should
         (equal
          (butlast
           (should-error
            (dbus-get-property
             :session dbus--test-service dbus--test-path
             dbus--test-interface property2)))
          `(dbus-error ,dbus-error-access-denied)))

        ;; `:readwrite' property, typed value (Bug#43252).
        (should
         (equal
          (dbus-register-property
           :session dbus--test-service dbus--test-path
           dbus--test-interface property3 :readwrite :object-path "/baz")
          `((:property :session ,dbus--test-interface ,property3)
            (,dbus--test-service ,dbus--test-path))))
        (should
         (string-equal
          (dbus-get-property
           :session dbus--test-service dbus--test-path
           dbus--test-interface property3)
          "/baz"))
        (should
         (string-equal
          (dbus-set-property
           :session dbus--test-service dbus--test-path
           dbus--test-interface property3 :object-path "/baz/baz")
          "/baz/baz"))
        (should
         (string-equal
          (dbus-get-property
           :session dbus--test-service dbus--test-path
           dbus--test-interface property3)
          "/baz/baz"))

        ;; Not registered property.
        (should
         (equal
          (butlast
           (should-error
            (dbus-get-property
             :session dbus--test-service dbus--test-path
             dbus--test-interface property4)))
          `(dbus-error ,dbus-error-unknown-property)))
        (should
         (equal
          (butlast
           (should-error
            (dbus-set-property
             :session dbus--test-service dbus--test-path
             dbus--test-interface property4 "foobarbaz")))
          `(dbus-error ,dbus-error-unknown-property)))

        ;; `dbus-get-all-properties'.  We cannot retrieve a value for
        ;; the property with `:write' access type.
        (let ((result
               (dbus-get-all-properties
                :session dbus--test-service dbus--test-path
                dbus--test-interface)))
          (should (string-equal (cdr (assoc property1 result)) "foo"))
          (should (string-equal (cdr (assoc property3 result)) "/baz/baz"))
          (should-not (assoc property2 result)))

        ;; `dbus-get-all-managed-objects'.  We cannot retrieve a value for
        ;; the property with `:write' access type.
        (let ((result
               (dbus-get-all-managed-objects
                :session dbus--test-service dbus--test-path)))
          (should (setq result (cadr (assoc dbus--test-path result))))
          (should (setq result (cadr (assoc dbus--test-interface result))))
          (should (string-equal (cdr (assoc property1 result)) "foo"))
          (should (string-equal (cdr (assoc property3 result)) "/baz/baz"))
          (should-not (assoc property2 result)))

        ;; Unregister property.
        (should (dbus-unregister-object registered))
        (should-not (dbus-unregister-object registered))
        (should
         (equal
          (butlast
           (should-error
            (dbus-get-property
             :session dbus--test-service dbus--test-path
             dbus--test-interface property1)))
          `(dbus-error ,dbus-error-unknown-property))))

    ;; Cleanup.
    (dbus-unregister-service :session dbus--test-service)))

;; The following test is inspired by Bug#43146.
(ert-deftest dbus-test06-register-property-several-paths ()
  "Check property registration for an own service at several paths."
  (skip-unless dbus--test-enabled-session-bus)
  (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service))

  (unwind-protect
      (let ((property1 "Property1")
            (property2 "Property2")
            (property3 "Property3"))

        ;; First path.
        (should
         (equal
          (dbus-register-property
           :session dbus--test-service dbus--test-path
           dbus--test-interface property1 :readwrite "foo")
          `((:property :session ,dbus--test-interface ,property1)
            (,dbus--test-service ,dbus--test-path))))
        (should
         (equal
          (dbus-register-property
           :session dbus--test-service dbus--test-path
           dbus--test-interface property2 :readwrite "bar")
          `((:property :session ,dbus--test-interface ,property2)
            (,dbus--test-service ,dbus--test-path))))
        (should
         (string-equal
          (dbus-get-property
           :session dbus--test-service dbus--test-path
           dbus--test-interface property1)
          "foo"))
        (should
         (string-equal
          (dbus-get-property
           :session dbus--test-service dbus--test-path
           dbus--test-interface property2)
          "bar"))

        (should
         (string-equal
          (dbus-set-property
           :session dbus--test-service dbus--test-path
           dbus--test-interface property1 "foofoo")
          "foofoo"))
        (should
         (string-equal
          (dbus-set-property
           :session dbus--test-service dbus--test-path
           dbus--test-interface property2 "barbar")
          "barbar"))
        (should
         (string-equal
          (dbus-get-property
           :session dbus--test-service dbus--test-path
           dbus--test-interface property1)
          "foofoo"))
        (should
         (string-equal
          (dbus-get-property
           :session dbus--test-service dbus--test-path
           dbus--test-interface property2)
          "barbar"))

        ;; Second path.
        (should
         (equal
          (dbus-register-property
           :session dbus--test-service (concat dbus--test-path dbus--test-path)
           dbus--test-interface property2 :readwrite "foo")
          `((:property :session ,dbus--test-interface ,property2)
            (,dbus--test-service ,(concat dbus--test-path dbus--test-path)))))
        (should
         (equal
          (dbus-register-property
           :session dbus--test-service (concat dbus--test-path dbus--test-path)
           dbus--test-interface property3 :readwrite "bar")
          `((:property :session ,dbus--test-interface ,property3)
            (,dbus--test-service ,(concat dbus--test-path dbus--test-path)))))
        (should
         (string-equal
          (dbus-get-property
           :session dbus--test-service (concat dbus--test-path dbus--test-path)
           dbus--test-interface property2)
          "foo"))
        (should
         (string-equal
          (dbus-get-property
           :session dbus--test-service (concat dbus--test-path dbus--test-path)
           dbus--test-interface property3)
          "bar"))

        (should
         (string-equal
          (dbus-set-property
           :session dbus--test-service (concat dbus--test-path dbus--test-path)
           dbus--test-interface property2 "foofoo")
          "foofoo"))
        (should
         (string-equal
          (dbus-set-property
           :session dbus--test-service (concat dbus--test-path dbus--test-path)
           dbus--test-interface property3 "barbar")
          "barbar"))
        (should
         (string-equal
          (dbus-get-property
           :session dbus--test-service (concat dbus--test-path dbus--test-path)
           dbus--test-interface property2)
          "foofoo"))
        (should
         (string-equal
          (dbus-get-property
           :session dbus--test-service (concat dbus--test-path dbus--test-path)
           dbus--test-interface property3)
          "barbar"))

        ;; Everything is still fine, tested with `dbus-get-all-properties'.
        (let ((result
               (dbus-get-all-properties
                :session dbus--test-service dbus--test-path
                dbus--test-interface)))
          (should (string-equal (cdr (assoc property1 result)) "foofoo"))
          (should (string-equal (cdr (assoc property2 result)) "barbar"))
          (should-not (assoc property3 result)))

        (let ((result
               (dbus-get-all-properties
                :session dbus--test-service
                (concat dbus--test-path dbus--test-path) dbus--test-interface)))
          (should (string-equal (cdr (assoc property2 result)) "foofoo"))
          (should (string-equal (cdr (assoc property3 result)) "barbar"))
          (should-not (assoc property1 result)))

        ;; Final check with `dbus-get-all-managed-objects'.
        (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 (string-equal (cdr (assoc property1 result1)) "foofoo"))
          (should (string-equal (cdr (assoc property2 result1)) "barbar"))
          (should-not (assoc property3 result1))

          (should
           (setq
            result1
            (cadr (assoc (concat dbus--test-path dbus--test-path) result))))
          (should (setq result1 (cadr (assoc dbus--test-interface result1))))
          (should (string-equal (cdr (assoc property2 result1)) "foofoo"))
          (should (string-equal (cdr (assoc property3 result1)) "barbar"))
          (should-not (assoc property1 result1))))

    ;; Cleanup.
    (dbus-unregister-service :session dbus--test-service)))

(ert-deftest dbus-test06-register-property-emits-signal ()
  "Check property registration for an own service, including signalling."
  (skip-unless dbus--test-enabled-session-bus)
  (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service))

  (unwind-protect
      (let ((property "Property")
            (handler #'dbus--test-signal-handler))

        ;; Register signal handler.
        (should
         (equal
          (dbus-register-signal
           :session dbus--test-service dbus--test-path
           dbus-interface-properties "PropertiesChanged" handler)
          `((:signal :session ,dbus-interface-properties "PropertiesChanged")
            (,dbus--test-service ,dbus--test-path ,handler))))

        ;; Register property.
        (setq dbus--test-signal-received nil)
        (should
         (equal
          (dbus-register-property
           :session dbus--test-service dbus--test-path
           dbus--test-interface property :readwrite "foo" 'emits-signal)
          `((:property :session ,dbus--test-interface ,property)
            (,dbus--test-service ,dbus--test-path))))
	(with-timeout (1 (dbus--test-timeout-handler))
          (while (null dbus--test-signal-received)
            (read-event nil nil 0.1)))
        ;; It returns two arguments, "changed_properties" (an array of
        ;; dict entries) and "invalidated_properties" (an array of
        ;; strings).
        (should (equal dbus--test-signal-received `(((,property ("foo"))) ())))

        (should
         (equal
          (dbus-get-property
           :session dbus--test-service dbus--test-path
           dbus--test-interface property)
          "foo"))

        ;; Set property.  The new value shall be signalled.
        (setq dbus--test-signal-received nil)
        (should
         (equal
          (dbus-set-property
           :session dbus--test-service dbus--test-path
           dbus--test-interface property
           '(:array :byte 1 :byte 2 :byte 3))
          '(1 2 3)))
	(with-timeout (1 (dbus--test-timeout-handler))
          (while (null dbus--test-signal-received)
            (read-event nil nil 0.1)))
        (should
         (equal
          dbus--test-signal-received `(((,property ((1 2 3)))) ())))

        (should
         (equal
          (dbus-get-property
           :session dbus--test-service dbus--test-path
           dbus--test-interface property)
          '(1 2 3))))

    ;; 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 D-Bus 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-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 "/node0"))
            :dict-entry ("six"  (:variant (:array :byte 4 :byte 5 :byte 6))))
           . (("four"
               ("value of four"))
              ("five"
               ("/node0"))
              ("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            ; Syntax emphasizing :dict compound type.
         "Dictionary"
         '((:array
            (:dict-entry :string "seven" (:variant :string "value of seven"))
            (:dict-entry "eight" (:variant :object-path "/node8"))
            (:dict-entry "nine"  (:variant (:array :byte 9 :byte 27 :byte 81))))
           . (("seven"
               ("value of seven"))
              ("eight"
               ("/node8"))
              ("nine"
               ((9 27 81)))))
         '((:array
            (:dict-entry :string "key4"  (:variant (:array :byte 7 :byte 49 :byte 125)))
            (:dict-entry "key5" (:variant :string "obsolete"))
            (:dict-entry "key6" (:variant :object-path "/node6/node7")))
           . (("key4"
               ((7 49 125)))
              ("key5"
               ("obsolete"))
              ("key6"
               ("/node6/node7")))))

        (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.
         (dbus-set-property
          :session dbus--test-service dbus--test-path dbus--test-interface
          "StringArray" '(:array "seven" "eight" :string "nine"))
         :type 'dbus-error)

        (should                    ; Property value preserved on error.
         (equal
          (dbus-get-property
           :session dbus--test-service dbus--test-path dbus--test-interface
           "StringArray")
          '("one" "two" "three")))

        (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
         (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"))
         :type 'wrong-type-argument)

        ;; Test in-range integer values.
        (should
         (equal
          (dbus-register-property
           :session dbus--test-service dbus--test-path dbus--test-interface
           "ByteValue" :readwrite :byte 255)
          `((: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")
          255))

        (should
         (equal
          (dbus-register-property
           :session dbus--test-service dbus--test-path dbus--test-interface
           "ShortValue" :readwrite :int16 32767)
          `((:property :session ,dbus--test-interface "ShortValue")
	    (,dbus--test-service ,dbus--test-path))))

        (should
         (=
          (dbus-get-property
           :session dbus--test-service dbus--test-path dbus--test-interface
           "ShortValue")
          32767))

        (should
         (equal
          (dbus-register-property
           :session dbus--test-service dbus--test-path dbus--test-interface
           "UShortValue" :readwrite :uint16 65535)
          `((:property :session ,dbus--test-interface "UShortValue")
	    (,dbus--test-service ,dbus--test-path))))

        (should
         (=
          (dbus-get-property
           :session dbus--test-service dbus--test-path dbus--test-interface
           "UShortValue")
          65535))

        (should
         (equal
          (dbus-register-property
           :session dbus--test-service dbus--test-path dbus--test-interface
           "IntValue" :readwrite :int32 2147483647)
          `((:property :session ,dbus--test-interface "IntValue")
	    (,dbus--test-service ,dbus--test-path))))

        (should
         (=
          (dbus-get-property
           :session dbus--test-service dbus--test-path
           dbus--test-interface "IntValue")
          2147483647))

        (should
         (equal
          (dbus-register-property
           :session dbus--test-service dbus--test-path dbus--test-interface
           "UIntValue" :readwrite :uint32 4294967295)
          `((:property :session ,dbus--test-interface "UIntValue")
	    (,dbus--test-service ,dbus--test-path))))

        (should
         (=
          (dbus-get-property
           :session dbus--test-service dbus--test-path dbus--test-interface
           "UIntValue")
          4294967295))

        (should
         (equal
          (dbus-register-property
           :session dbus--test-service dbus--test-path dbus--test-interface
           "LongValue" :readwrite :int64 9223372036854775807)
          `((:property :session ,dbus--test-interface "LongValue")
	    (,dbus--test-service ,dbus--test-path))))

        (should
         (=
          (dbus-get-property
           :session dbus--test-service dbus--test-path dbus--test-interface
           "LongValue")
          9223372036854775807))

        (should
         (equal
          (dbus-register-property
           :session dbus--test-service dbus--test-path dbus--test-interface
           "ULongValue" :readwrite :uint64 18446744073709551615)
          `((:property :session ,dbus--test-interface "ULongValue")
	    (,dbus--test-service ,dbus--test-path))))

        (should
         (=
          (dbus-get-property
           :session dbus--test-service dbus--test-path dbus--test-interface
           "ULongValue")
          18446744073709551615))

        ;; Test integer overflow.
        (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-error
         (dbus-register-property
          :session dbus--test-service dbus--test-path dbus--test-interface
          "ShortValue" :readwrite :int16 32800)
         :type 'args-out-of-range)

        (should-error
         (dbus-register-property
          :session dbus--test-service dbus--test-path dbus--test-interface
          "UShortValue" :readwrite :uint16 65600)
         :type 'args-out-of-range)

        (should-error
         (dbus-register-property
          :session dbus--test-service dbus--test-path dbus--test-interface
          "IntValue" :readwrite :int32 2147483700)
         :type 'args-out-of-range)

        (should-error
         (dbus-register-property
          :session dbus--test-service dbus--test-path dbus--test-interface
          "UIntValue" :readwrite :uint32 4294967300)
         :type 'args-out-of-range)

        (should-error
         (dbus-register-property
          :session dbus--test-service dbus--test-path dbus--test-interface
          "LongValue" :readwrite :int64 9223372036854775900)
         :type 'args-out-of-range)

        (should-error
         (dbus-register-property
          :session dbus--test-service dbus--test-path dbus--test-interface
          "ULongValue" :readwrite :uint64 18446744073709551700)
         :type 'args-out-of-range)

        ;; dbus-set-property may change property type.
        (should
         (=
          (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                         ; Another change property type test.
         (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
         (dbus-register-property
          :session dbus--test-service dbus--test-path dbus--test-interface
          "InvalidType" :readwrite :keyword 128)
         :type 'wrong-type-argument))

    ;; Cleanup.
    (dbus-unregister-service :session dbus--test-service)))

(defun dbus-test-all (&optional interactive)
  "Run all tests for \\[dbus]."
  (interactive "p")
  (funcall (if interactive #'ert-run-tests-interactively #'ert-run-tests-batch)
           "^dbus"))

(provide 'dbus-tests)
;;; dbus-tests.el ends here