bug#43252: 27.1; DBus properties lack type hints or overrides

bug#43252: 27.1; DBus properties lack type hints or overrides

[Hugh Daschbach]

In order to implement a service exposing interface
"org.bluez.GattService1", I need to export the properties defined for
that interface.  (See,
https://kernel.googlesource.com/pub/scm/bluetooth/bluez/+/refs/tags/5.55/doc/gatt-api.txt)

There are two properties that require an object path: "Device", and
"Includes".  Since there is no type information associated with the
registered property, introspection supplies its best guess.  If the
value is a string it is described as a :string, not an :object-path

There doesn't seem to be any mechanism to register the property and have
introspection describe it as as an :object-path.

Am I missing something?  Is this out of scope?  Is there anyway to
specify simple types for parameter values?

Thanks,
Hugh


In GNU Emacs 27.1 (build 1, x86_64-pc-linux-gnu, X toolkit, Xaw3d scroll bars)
 of 2020-08-06 built on klaatu
Repository revision: 86d8d76aa36037184db0b2897c434cdaab1a9ae8
Repository branch: emacs-27
Windowing system distributor 'The X.Org Foundation', version 11.0.12008000
System Description: Artix Linux

Recent messages:
[mu4e] Indexing completed; processed 0, updated 0, cleaned-up 0
Mark set
[mu4e] Indexing... processed 2, updated 2
[mu4e] Indexing completed; processed 2, updated 2, cleaned-up 0
[mu4e] Found 19 matching messages
Mark set
C-x C-g is undefined
Winner undo (1 / 199)
Winner undo (2 / 198)
Auto-saving...done

Configured using:
 'configure --with-x-toolkit=lucid'

Configured features:
XAW3D XPM JPEG TIFF GIF PNG RSVG SOUND GPM DBUS GSETTINGS GLIB NOTIFY
INOTIFY ACL GNUTLS LIBXML2 FREETYPE HARFBUZZ M17N_FLT LIBOTF XFT ZLIB
TOOLKIT_SCROLL_BARS LUCID X11 XDBE XIM MODULES THREADS LIBSYSTEMD JSON
PDUMPER LCMS2 GMP

Important settings:
  value of $LANG: en_US.UTF-8
  locale-coding-system: utf-8-unix

Major mode: Emacs-Lisp

Minor modes in effect:
  pdf-occur-global-minor-mode: t
  global-magit-file-mode: t
  magit-file-mode: t
  magit-auto-revert-mode: t
  global-git-commit-mode: t
  async-bytecomp-package-mode: t
  ggtags-navigation-mode: t
  desktop-save-mode: t
  which-key-mode: t
  hungry-delete-mode: t
  paredit-mode: t
  amx-mode: t
  ivy-mode: t
  winner-mode: t
  shell-dirtrack-mode: t
  save-place-mode: t
  global-edit-server-edit-mode: t
  auto-insert-mode: t
  override-global-mode: t
  straight-use-package-mode: t
  straight-package-neutering-mode: t
  tooltip-mode: t
  global-eldoc-mode: t
  eldoc-mode: t
  electric-indent-mode: t
  mouse-wheel-mode: t
  menu-bar-mode: t
  file-name-shadow-mode: t
  global-font-lock-mode: t
  font-lock-mode: t
  auto-composition-mode: t
  auto-encryption-mode: t
  auto-compression-mode: t
  column-number-mode: t
  line-number-mode: t
  transient-mark-mode: t
  abbrev-mode: t

Load-path shadows:
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ox hides /home/hugh/.config/emacs/straight/build/org/ox
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ox-texinfo hides /home/hugh/.config/emacs/straight/build/org/ox-texinfo
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ox-publish hides /home/hugh/.config/emacs/straight/build/org/ox-publish
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ox-org hides /home/hugh/.config/emacs/straight/build/org/ox-org
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ox-odt hides /home/hugh/.config/emacs/straight/build/org/ox-odt
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ox-md hides /home/hugh/.config/emacs/straight/build/org/ox-md
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ox-man hides /home/hugh/.config/emacs/straight/build/org/ox-man
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ox-latex hides /home/hugh/.config/emacs/straight/build/org/ox-latex
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ox-icalendar hides /home/hugh/.config/emacs/straight/build/org/ox-icalendar
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ox-html hides /home/hugh/.config/emacs/straight/build/org/ox-html
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ox-beamer hides /home/hugh/.config/emacs/straight/build/org/ox-beamer
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ox-ascii hides /home/hugh/.config/emacs/straight/build/org/ox-ascii
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org hides /home/hugh/.config/emacs/straight/build/org/org
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-timer hides /home/hugh/.config/emacs/straight/build/org/org-timer
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-tempo hides /home/hugh/.config/emacs/straight/build/org/org-tempo
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-table hides /home/hugh/.config/emacs/straight/build/org/org-table
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-src hides /home/hugh/.config/emacs/straight/build/org/org-src
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-refile hides /home/hugh/.config/emacs/straight/build/org/org-refile
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-protocol hides /home/hugh/.config/emacs/straight/build/org/org-protocol
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-plot hides /home/hugh/.config/emacs/straight/build/org/org-plot
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-pcomplete hides /home/hugh/.config/emacs/straight/build/org/org-pcomplete
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-num hides /home/hugh/.config/emacs/straight/build/org/org-num
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-mouse hides /home/hugh/.config/emacs/straight/build/org/org-mouse
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-mobile hides /home/hugh/.config/emacs/straight/build/org/org-mobile
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-macs hides /home/hugh/.config/emacs/straight/build/org/org-macs
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-macro hides /home/hugh/.config/emacs/straight/build/org/org-macro
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-list hides /home/hugh/.config/emacs/straight/build/org/org-list
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-lint hides /home/hugh/.config/emacs/straight/build/org/org-lint
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-keys hides /home/hugh/.config/emacs/straight/build/org/org-keys
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-inlinetask hides /home/hugh/.config/emacs/straight/build/org/org-inlinetask
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-indent hides /home/hugh/.config/emacs/straight/build/org/org-indent
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-id hides /home/hugh/.config/emacs/straight/build/org/org-id
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-habit hides /home/hugh/.config/emacs/straight/build/org/org-habit
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-goto hides /home/hugh/.config/emacs/straight/build/org/org-goto
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-footnote hides /home/hugh/.config/emacs/straight/build/org/org-footnote
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-feed hides /home/hugh/.config/emacs/straight/build/org/org-feed
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-faces hides /home/hugh/.config/emacs/straight/build/org/org-faces
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-entities hides /home/hugh/.config/emacs/straight/build/org/org-entities
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-element hides /home/hugh/.config/emacs/straight/build/org/org-element
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-duration hides /home/hugh/.config/emacs/straight/build/org/org-duration
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-datetree hides /home/hugh/.config/emacs/straight/build/org/org-datetree
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-ctags hides /home/hugh/.config/emacs/straight/build/org/org-ctags
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-crypt hides /home/hugh/.config/emacs/straight/build/org/org-crypt
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-compat hides /home/hugh/.config/emacs/straight/build/org/org-compat
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-colview hides /home/hugh/.config/emacs/straight/build/org/org-colview
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-clock hides /home/hugh/.config/emacs/straight/build/org/org-clock
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-capture hides /home/hugh/.config/emacs/straight/build/org/org-capture
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-attach hides /home/hugh/.config/emacs/straight/build/org/org-attach
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-attach-git hides /home/hugh/.config/emacs/straight/build/org/org-attach-git
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-archive hides /home/hugh/.config/emacs/straight/build/org/org-archive
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-agenda hides /home/hugh/.config/emacs/straight/build/org/org-agenda
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ol hides /home/hugh/.config/emacs/straight/build/org/ol
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ol-w3m hides /home/hugh/.config/emacs/straight/build/org/ol-w3m
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ol-rmail hides /home/hugh/.config/emacs/straight/build/org/ol-rmail
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ol-mhe hides /home/hugh/.config/emacs/straight/build/org/ol-mhe
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ol-irc hides /home/hugh/.config/emacs/straight/build/org/ol-irc
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ol-info hides /home/hugh/.config/emacs/straight/build/org/ol-info
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ol-gnus hides /home/hugh/.config/emacs/straight/build/org/ol-gnus
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ol-eww hides /home/hugh/.config/emacs/straight/build/org/ol-eww
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ol-eshell hides /home/hugh/.config/emacs/straight/build/org/ol-eshell
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ol-docview hides /home/hugh/.config/emacs/straight/build/org/ol-docview
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ol-bibtex hides /home/hugh/.config/emacs/straight/build/org/ol-bibtex
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ol-bbdb hides /home/hugh/.config/emacs/straight/build/org/ol-bbdb
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob hides /home/hugh/.config/emacs/straight/build/org/ob
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-vala hides /home/hugh/.config/emacs/straight/build/org/ob-vala
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-tangle hides /home/hugh/.config/emacs/straight/build/org/ob-tangle
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-table hides /home/hugh/.config/emacs/straight/build/org/ob-table
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-stan hides /home/hugh/.config/emacs/straight/build/org/ob-stan
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-sqlite hides /home/hugh/.config/emacs/straight/build/org/ob-sqlite
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-sql hides /home/hugh/.config/emacs/straight/build/org/ob-sql
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-shen hides /home/hugh/.config/emacs/straight/build/org/ob-shen
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-shell hides /home/hugh/.config/emacs/straight/build/org/ob-shell
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-sed hides /home/hugh/.config/emacs/straight/build/org/ob-sed
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-screen hides /home/hugh/.config/emacs/straight/build/org/ob-screen
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-scheme hides /home/hugh/.config/emacs/straight/build/org/ob-scheme
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-sass hides /home/hugh/.config/emacs/straight/build/org/ob-sass
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-ruby hides /home/hugh/.config/emacs/straight/build/org/ob-ruby
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-ref hides /home/hugh/.config/emacs/straight/build/org/ob-ref
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-python hides /home/hugh/.config/emacs/straight/build/org/ob-python
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-processing hides /home/hugh/.config/emacs/straight/build/org/ob-processing
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-plantuml hides /home/hugh/.config/emacs/straight/build/org/ob-plantuml
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-picolisp hides /home/hugh/.config/emacs/straight/build/org/ob-picolisp
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-perl hides /home/hugh/.config/emacs/straight/build/org/ob-perl
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-org hides /home/hugh/.config/emacs/straight/build/org/ob-org
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-octave hides /home/hugh/.config/emacs/straight/build/org/ob-octave
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-ocaml hides /home/hugh/.config/emacs/straight/build/org/ob-ocaml
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-mscgen hides /home/hugh/.config/emacs/straight/build/org/ob-mscgen
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-maxima hides /home/hugh/.config/emacs/straight/build/org/ob-maxima
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-matlab hides /home/hugh/.config/emacs/straight/build/org/ob-matlab
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-makefile hides /home/hugh/.config/emacs/straight/build/org/ob-makefile
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-lua hides /home/hugh/.config/emacs/straight/build/org/ob-lua
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-lob hides /home/hugh/.config/emacs/straight/build/org/ob-lob
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-lisp hides /home/hugh/.config/emacs/straight/build/org/ob-lisp
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-lilypond hides /home/hugh/.config/emacs/straight/build/org/ob-lilypond
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-ledger hides /home/hugh/.config/emacs/straight/build/org/ob-ledger
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-latex hides /home/hugh/.config/emacs/straight/build/org/ob-latex
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-js hides /home/hugh/.config/emacs/straight/build/org/ob-js
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-java hides /home/hugh/.config/emacs/straight/build/org/ob-java
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-io hides /home/hugh/.config/emacs/straight/build/org/ob-io
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-hledger hides /home/hugh/.config/emacs/straight/build/org/ob-hledger
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-haskell hides /home/hugh/.config/emacs/straight/build/org/ob-haskell
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-groovy hides /home/hugh/.config/emacs/straight/build/org/ob-groovy
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-gnuplot hides /home/hugh/.config/emacs/straight/build/org/ob-gnuplot
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-fortran hides /home/hugh/.config/emacs/straight/build/org/ob-fortran
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-forth hides /home/hugh/.config/emacs/straight/build/org/ob-forth
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-exp hides /home/hugh/.config/emacs/straight/build/org/ob-exp
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-eval hides /home/hugh/.config/emacs/straight/build/org/ob-eval
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-eshell hides /home/hugh/.config/emacs/straight/build/org/ob-eshell
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-emacs-lisp hides /home/hugh/.config/emacs/straight/build/org/ob-emacs-lisp
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-ebnf hides /home/hugh/.config/emacs/straight/build/org/ob-ebnf
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-dot hides /home/hugh/.config/emacs/straight/build/org/ob-dot
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-ditaa hides /home/hugh/.config/emacs/straight/build/org/ob-ditaa
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-css hides /home/hugh/.config/emacs/straight/build/org/ob-css
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-core hides /home/hugh/.config/emacs/straight/build/org/ob-core
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-coq hides /home/hugh/.config/emacs/straight/build/org/ob-coq
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-comint hides /home/hugh/.config/emacs/straight/build/org/ob-comint
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-clojure hides /home/hugh/.config/emacs/straight/build/org/ob-clojure
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-calc hides /home/hugh/.config/emacs/straight/build/org/ob-calc
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-awk hides /home/hugh/.config/emacs/straight/build/org/ob-awk
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-asymptote hides /home/hugh/.config/emacs/straight/build/org/ob-asymptote
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-abc hides /home/hugh/.config/emacs/straight/build/org/ob-abc
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-R hides /home/hugh/.config/emacs/straight/build/org/ob-R
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-J hides /home/hugh/.config/emacs/straight/build/org/ob-J
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-C hides /home/hugh/.config/emacs/straight/build/org/ob-C
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-loaddefs hides /home/hugh/.config/emacs/straight/build/org/org-loaddefs
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-install hides /home/hugh/.config/emacs/straight/build/org/org-install
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ox-texinfo hides /usr/local/share/emacs/27.1/lisp/org/ox-texinfo
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ox-publish hides /usr/local/share/emacs/27.1/lisp/org/ox-publish
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ox-org hides /usr/local/share/emacs/27.1/lisp/org/ox-org
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ox-odt hides /usr/local/share/emacs/27.1/lisp/org/ox-odt
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ox-md hides /usr/local/share/emacs/27.1/lisp/org/ox-md
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ox-man hides /usr/local/share/emacs/27.1/lisp/org/ox-man
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ox-latex hides /usr/local/share/emacs/27.1/lisp/org/ox-latex
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ox-icalendar hides /usr/local/share/emacs/27.1/lisp/org/ox-icalendar
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ox-html hides /usr/local/share/emacs/27.1/lisp/org/ox-html
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ox hides /usr/local/share/emacs/27.1/lisp/org/ox
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ox-beamer hides /usr/local/share/emacs/27.1/lisp/org/ox-beamer
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ox-ascii hides /usr/local/share/emacs/27.1/lisp/org/ox-ascii
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-timer hides /usr/local/share/emacs/27.1/lisp/org/org-timer
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-tempo hides /usr/local/share/emacs/27.1/lisp/org/org-tempo
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-table hides /usr/local/share/emacs/27.1/lisp/org/org-table
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-src hides /usr/local/share/emacs/27.1/lisp/org/org-src
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-protocol hides /usr/local/share/emacs/27.1/lisp/org/org-protocol
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-plot hides /usr/local/share/emacs/27.1/lisp/org/org-plot
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-pcomplete hides /usr/local/share/emacs/27.1/lisp/org/org-pcomplete
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-num hides /usr/local/share/emacs/27.1/lisp/org/org-num
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-mouse hides /usr/local/share/emacs/27.1/lisp/org/org-mouse
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-mobile hides /usr/local/share/emacs/27.1/lisp/org/org-mobile
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-macs hides /usr/local/share/emacs/27.1/lisp/org/org-macs
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-macro hides /usr/local/share/emacs/27.1/lisp/org/org-macro
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-list hides /usr/local/share/emacs/27.1/lisp/org/org-list
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-lint hides /usr/local/share/emacs/27.1/lisp/org/org-lint
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-keys hides /usr/local/share/emacs/27.1/lisp/org/org-keys
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-inlinetask hides /usr/local/share/emacs/27.1/lisp/org/org-inlinetask
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-indent hides /usr/local/share/emacs/27.1/lisp/org/org-indent
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-id hides /usr/local/share/emacs/27.1/lisp/org/org-id
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-habit hides /usr/local/share/emacs/27.1/lisp/org/org-habit
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-goto hides /usr/local/share/emacs/27.1/lisp/org/org-goto
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-footnote hides /usr/local/share/emacs/27.1/lisp/org/org-footnote
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-feed hides /usr/local/share/emacs/27.1/lisp/org/org-feed
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-faces hides /usr/local/share/emacs/27.1/lisp/org/org-faces
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-entities hides /usr/local/share/emacs/27.1/lisp/org/org-entities
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-element hides /usr/local/share/emacs/27.1/lisp/org/org-element
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org hides /usr/local/share/emacs/27.1/lisp/org/org
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-duration hides /usr/local/share/emacs/27.1/lisp/org/org-duration
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-datetree hides /usr/local/share/emacs/27.1/lisp/org/org-datetree
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-ctags hides /usr/local/share/emacs/27.1/lisp/org/org-ctags
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-crypt hides /usr/local/share/emacs/27.1/lisp/org/org-crypt
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-compat hides /usr/local/share/emacs/27.1/lisp/org/org-compat
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-colview hides /usr/local/share/emacs/27.1/lisp/org/org-colview
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-clock hides /usr/local/share/emacs/27.1/lisp/org/org-clock
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-capture hides /usr/local/share/emacs/27.1/lisp/org/org-capture
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-attach-git hides /usr/local/share/emacs/27.1/lisp/org/org-attach-git
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-attach hides /usr/local/share/emacs/27.1/lisp/org/org-attach
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-archive hides /usr/local/share/emacs/27.1/lisp/org/org-archive
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-agenda hides /usr/local/share/emacs/27.1/lisp/org/org-agenda
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ol-w3m hides /usr/local/share/emacs/27.1/lisp/org/ol-w3m
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ol-rmail hides /usr/local/share/emacs/27.1/lisp/org/ol-rmail
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ol-mhe hides /usr/local/share/emacs/27.1/lisp/org/ol-mhe
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ol-irc hides /usr/local/share/emacs/27.1/lisp/org/ol-irc
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ol-info hides /usr/local/share/emacs/27.1/lisp/org/ol-info
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ol-gnus hides /usr/local/share/emacs/27.1/lisp/org/ol-gnus
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ol-eww hides /usr/local/share/emacs/27.1/lisp/org/ol-eww
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ol-eshell hides /usr/local/share/emacs/27.1/lisp/org/ol-eshell
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ol hides /usr/local/share/emacs/27.1/lisp/org/ol
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ol-docview hides /usr/local/share/emacs/27.1/lisp/org/ol-docview
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ol-bibtex hides /usr/local/share/emacs/27.1/lisp/org/ol-bibtex
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ol-bbdb hides /usr/local/share/emacs/27.1/lisp/org/ol-bbdb
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-vala hides /usr/local/share/emacs/27.1/lisp/org/ob-vala
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-tangle hides /usr/local/share/emacs/27.1/lisp/org/ob-tangle
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-table hides /usr/local/share/emacs/27.1/lisp/org/ob-table
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-stan hides /usr/local/share/emacs/27.1/lisp/org/ob-stan
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-sqlite hides /usr/local/share/emacs/27.1/lisp/org/ob-sqlite
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-sql hides /usr/local/share/emacs/27.1/lisp/org/ob-sql
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-shen hides /usr/local/share/emacs/27.1/lisp/org/ob-shen
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-shell hides /usr/local/share/emacs/27.1/lisp/org/ob-shell
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-sed hides /usr/local/share/emacs/27.1/lisp/org/ob-sed
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-screen hides /usr/local/share/emacs/27.1/lisp/org/ob-screen
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-scheme hides /usr/local/share/emacs/27.1/lisp/org/ob-scheme
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-sass hides /usr/local/share/emacs/27.1/lisp/org/ob-sass
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-ruby hides /usr/local/share/emacs/27.1/lisp/org/ob-ruby
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-R hides /usr/local/share/emacs/27.1/lisp/org/ob-R
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-ref hides /usr/local/share/emacs/27.1/lisp/org/ob-ref
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-python hides /usr/local/share/emacs/27.1/lisp/org/ob-python
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-processing hides /usr/local/share/emacs/27.1/lisp/org/ob-processing
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-plantuml hides /usr/local/share/emacs/27.1/lisp/org/ob-plantuml
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-picolisp hides /usr/local/share/emacs/27.1/lisp/org/ob-picolisp
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-perl hides /usr/local/share/emacs/27.1/lisp/org/ob-perl
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-org hides /usr/local/share/emacs/27.1/lisp/org/ob-org
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-octave hides /usr/local/share/emacs/27.1/lisp/org/ob-octave
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-ocaml hides /usr/local/share/emacs/27.1/lisp/org/ob-ocaml
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-mscgen hides /usr/local/share/emacs/27.1/lisp/org/ob-mscgen
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-maxima hides /usr/local/share/emacs/27.1/lisp/org/ob-maxima
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-matlab hides /usr/local/share/emacs/27.1/lisp/org/ob-matlab
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-makefile hides /usr/local/share/emacs/27.1/lisp/org/ob-makefile
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-lua hides /usr/local/share/emacs/27.1/lisp/org/ob-lua
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-lob hides /usr/local/share/emacs/27.1/lisp/org/ob-lob
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-lisp hides /usr/local/share/emacs/27.1/lisp/org/ob-lisp
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-lilypond hides /usr/local/share/emacs/27.1/lisp/org/ob-lilypond
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-ledger hides /usr/local/share/emacs/27.1/lisp/org/ob-ledger
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-latex hides /usr/local/share/emacs/27.1/lisp/org/ob-latex
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-js hides /usr/local/share/emacs/27.1/lisp/org/ob-js
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-J hides /usr/local/share/emacs/27.1/lisp/org/ob-J
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-java hides /usr/local/share/emacs/27.1/lisp/org/ob-java
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-io hides /usr/local/share/emacs/27.1/lisp/org/ob-io
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-hledger hides /usr/local/share/emacs/27.1/lisp/org/ob-hledger
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-haskell hides /usr/local/share/emacs/27.1/lisp/org/ob-haskell
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-groovy hides /usr/local/share/emacs/27.1/lisp/org/ob-groovy
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-gnuplot hides /usr/local/share/emacs/27.1/lisp/org/ob-gnuplot
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-fortran hides /usr/local/share/emacs/27.1/lisp/org/ob-fortran
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-forth hides /usr/local/share/emacs/27.1/lisp/org/ob-forth
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-exp hides /usr/local/share/emacs/27.1/lisp/org/ob-exp
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-eval hides /usr/local/share/emacs/27.1/lisp/org/ob-eval
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-eshell hides /usr/local/share/emacs/27.1/lisp/org/ob-eshell
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-emacs-lisp hides /usr/local/share/emacs/27.1/lisp/org/ob-emacs-lisp
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob hides /usr/local/share/emacs/27.1/lisp/org/ob
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-ebnf hides /usr/local/share/emacs/27.1/lisp/org/ob-ebnf
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-dot hides /usr/local/share/emacs/27.1/lisp/org/ob-dot
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-ditaa hides /usr/local/share/emacs/27.1/lisp/org/ob-ditaa
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-css hides /usr/local/share/emacs/27.1/lisp/org/ob-css
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-core hides /usr/local/share/emacs/27.1/lisp/org/ob-core
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-coq hides /usr/local/share/emacs/27.1/lisp/org/ob-coq
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-comint hides /usr/local/share/emacs/27.1/lisp/org/ob-comint
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-clojure hides /usr/local/share/emacs/27.1/lisp/org/ob-clojure
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-C hides /usr/local/share/emacs/27.1/lisp/org/ob-C
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-calc hides /usr/local/share/emacs/27.1/lisp/org/ob-calc
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-awk hides /usr/local/share/emacs/27.1/lisp/org/ob-awk
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-asymptote hides /usr/local/share/emacs/27.1/lisp/org/ob-asymptote
/home/hugh/.config/emacs/straight/build/org-plus-contrib/ob-abc hides /usr/local/share/emacs/27.1/lisp/org/ob-abc
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-loaddefs hides /usr/local/share/emacs/27.1/lisp/org/org-loaddefs
/home/hugh/.config/emacs/straight/build/org-plus-contrib/org-install hides /usr/local/share/emacs/27.1/lisp/org/org-install
/home/hugh/.config/emacs/straight/build/let-alist/let-alist hides /usr/local/share/emacs/27.1/lisp/emacs-lisp/let-alist

Features:
(shadow emacsbug sh-script smie python tramp-cmds rng-xsd xsd-regexp
rng-cmpct rng-nxml rng-valid nxml-mode nxml-outln nxml-rap sgml-mode
company-tng company transpose-frame autoload lisp-mnt descr-text
gl-bluez-gatt dabbrev quail org-eldoc ol-eww ol-rmail ol-mhe ol-irc
ol-info ol-gnus nnir ol-docview ol-bibtex bibtex ol-bbdb ol-w3m pdf-sync
pdf-outline pdf-links pdf-history pdf-occur ibuf-ext pdf-isearch
let-alist pdf-annot tablist tablist-filter semantic/wisent/comp
semantic/wisent semantic/wisent/wisent semantic/util-modes semantic/util
semantic semantic/tag semantic/lex semantic/fw mode-local cedet pdf-misc
pdf-tools pdf-view pdf-cache pdf-info tq pdf-util rect epa-mail epa-file
mailalias face-remap tabify man view timezone gnutls url-http url-gw
url-cache url-auth eww mm-url magit-extras magit-bookmark
magit-submodule magit-obsolete magit-blame magit-stash magit-reflog
magit-bisect magit-push magit-pull magit-fetch magit-clone magit-remote
magit-commit magit-sequence magit-notes magit-worktree magit-tag
magit-merge magit-branch magit-reset magit-files magit-refs magit-status
magit package url-handlers magit-repos magit-apply magit-wip magit-log
which-func imenu magit-diff smerge-mode diff magit-core magit-autorevert
autorevert magit-margin magit-transient magit-process magit-mode
git-commit transient magit-git magit-section magit-utils crm log-edit
pcvs-util add-log with-editor async-bytecomp async tmm eieio-opt
speedbar sb-image ezimage dframe dbus-bluetooth dbus-formatters
dbus-inspector tree-mode flyspell repeat bug-reference macrostep-c
cmacexp macrostep ggtags etags fileloop ewoc cc-mode cc-fonts cc-guess
cc-menus cc-cmds cc-styles cc-align cc-engine cc-vars cc-defs pulse xref
project debug backtrace dired-aux tramp-cache tramp-sh tramp
tramp-loaddefs trampver tramp-integration files-x tramp-compat ls-lisp
recentf tree-widget visual-fill-column sort gnus-cite smiley shr-color
qp mm-archive mail-extr gnus-art mm-uu mml2015 mm-view mml-smime smime
dig gnus-sum gnus-group gnus-undo gnus-start gnus-cloud nnimap nnmail
mail-source utf7 netrc nnoo parse-time iso8601 gnus-spec gnus-int
gnus-range gnus-win gnus nnheader iso-transl csv executable disp-table
network-stream nsm cl-print ace-window avy rcirc help-fns radix-tree
persistent-soft list-utils pcache eieio-compat eieio-base font-utils
unicode-fonts misearch multi-isearch two-column vc-git diff-mode
elfeed-org elfeed-show elfeed-search bookmark elfeed-csv elfeed
elfeed-curl url url-proxy url-expand url-methods url-history mailcap
elfeed-log elfeed-db elfeed-lib url-queue xml-query mu4e mu4e-org
mu4e-main mu4e-view mu4e-headers mu4e-compose mu4e-context mu4e-draft
mu4e-actions ido rfc2368 smtpmail sendmail mu4e-mark mu4e-proc
mu4e-utils doc-view jka-compr image-mode exif mu4e-lists mu4e-message
flow-fill ox-reveal desktop frameset ox-hugo org-refile ffap thingatpt
ox-blackfriday ox-odt rng-loc rng-uri rng-parse rng-match rng-dt
rng-util rng-pttrn nxml-parse nxml-ns nxml-enc xmltok nxml-util ox-md
ox-html table ox-beamer ox-latex ox-ascii ox-publish ox org-element
avl-tree generator org org-macro org-footnote org-pcomplete org-list
org-faces org-entities noutline outline ob-gnuplot ob-dot ob-ditaa
ob-shell ob-awk ob-calc calc-store calc-trail calc-ext calc
calc-loaddefs calc-macs ob ob-tangle org-src ob-ref ob-lob ob-table
ob-exp ob-comint ob-emacs-lisp ob-core ob-eval org-table ol org-keys
org-compat org-macs org-loaddefs find-func cal-menu calendar
cal-loaddefs mule-util hl-line mu4e-vars message rmc format-spec rfc822
mml mml-sec epa derived epg epg-config gnus-util rmail rmail-loaddefs
time-date mm-decode mm-bodies mm-encode mail-parse rfc2231 rfc2047
rfc2045 mm-util ietf-drums mail-prsvr mailabbrev mail-utils gmm-utils
mailheader mu4e-meta which-key server hungry-delete paredit ivy-posframe
posframe ivy-hydra amx ivy flx delsel ivy-faces ivy-overlay colir color
winner url-privacy filenotify slime-company-autoloads slime-autoloads
macrostep-autoloads shr text-property-search url-cookie url-domsuf
url-util url-parse auth-source eieio eieio-core eieio-loaddefs
password-cache url-vars puny svg dom zenburn-theme
zenburn-theme-autoloads which-key-autoloads visual-fill-column-autoloads
unicode-fonts-autoloads ucs-utils-autoloads font-utils-autoloads
persistent-soft-autoloads list-utils-autoloads cl pcache-autoloads
tree-mode-autoloads transpose-frame-autoloads tex-mode shell pcomplete
smtpmail-multi-autoloads smart-mode-line-respectful-theme
smart-mode-line rich-minority smart-mode-line-autoloads
rich-minority-autoloads saveplace ripgrep-autoloads restclient-autoloads
pdf-tools-autoloads tablist-autoloads paredit-autoloads
ox-reveal-autoloads ox-hugo-autoloads org-gcal-autoloads
persist-autoloads request-deferred-autoloads deferred-autoloads
request-autoloads org-caldav-autoloads org-plus-contrib-autoloads
magit-svn-autoloads json-mode-autoloads json-snatcher-autoloads
json-reformat-autoloads ix grapnel ix-autoloads grapnel-autoloads
ivy-posframe-autoloads posframe-autoloads ivy-hydra-autoloads ispell
ielm pp ibuffer ibuffer-loaddefs hyperbole-autoloads kotl-autoloads
hydra lv hydra-autoloads lv-autoloads hungry-delete-autoloads
gnuplot-autoloads ggtags-autoloads geiser-autoloads flx-autoloads
forge-autoloads markdown-mode-autoloads magit-autoloads
git-commit-autoloads with-editor-autoloads transient-autoloads
async-autoloads ghub-autoloads treepy-autoloads let-alist-autoloads
closql-autoloads emacsql-sqlite-autoloads emacsql-autoloads
esup-autoloads elpher-autoloads emojify apropos tar-mode arc-mode
archive-mode pcase json map ht emojify-autoloads ht-autoloads
emms-autoloads elfeed-org-autoloads org-autoloads org-version
elfeed-autoloads edit-server advice edit-server-autoloads
dmenu-autoloads deft-autoloads dired-x use-package-ensure
dired-subtree-autoloads dired-hacks-utils-autoloads diminish
diminish-autoloads dictionary-autoloads link-autoloads
connection-autoloads delight-autoloads deadgrep-autoloads
spinner-autoloads dbus-inspector-autoloads dash-functional
dash-functional-autoloads csv-autoloads counsel-projectile-autoloads
projectile-autoloads pkg-info-autoloads epl-autoloads counsel-autoloads
swiper-autoloads ivy-autoloads company-quickhelp-autoloads
pos-tip-autoloads company-autoloads use-package-diminish autoinsert
amx-autoloads alert log4e rx notifications dbus xml gntp alert-autoloads
log4e-autoloads gntp-autoloads ag vc-svn compile comint ansi-color ring
find-dired s dash dired dired-loaddefs ag-autoloads s-autoloads
dash-autoloads adaptive-wrap adaptive-wrap-autoloads
ace-window-autoloads avy-autoloads finder-inf edmacro kmacro browse-url
cus-edit cus-start cus-load wid-edit use-package-bind-key bind-key
easy-mmode cl-seq use-package-core use-package-autoloads
bind-key-autoloads straight-autoloads info cl-extra help-mode easymenu
seq byte-opt straight subr-x cl-macs gv cl-loaddefs cl-lib bytecomp
byte-compile cconv early-init tooltip eldoc electric uniquify ediff-hook
vc-hooks lisp-float-type mwheel term/x-win x-win term/common-win x-dnd
tool-bar dnd fontset image regexp-opt fringe tabulated-list replace
newcomment text-mode elisp-mode lisp-mode prog-mode register page
tab-bar menu-bar rfn-eshadow isearch timer select scroll-bar mouse
jit-lock font-lock syntax facemenu font-core term/tty-colors frame
minibuffer cl-generic cham georgian utf-8-lang misc-lang vietnamese
tibetan thai tai-viet lao korean japanese eucjp-ms cp51932 hebrew greek
romanian slovak czech european ethiopic indian cyrillic chinese
composite charscript charprop case-table epa-hook jka-cmpr-hook help
simple abbrev obarray cl-preloaded nadvice loaddefs button faces
cus-face macroexp files text-properties overlay sha1 md5 base64 format
env code-pages mule custom widget hashtable-print-readable backquote
threads dbusbind inotify lcms2 dynamic-setting system-font-setting
font-render-setting x-toolkit x multi-tty make-network-process emacs)

Memory information:
((conses 16 2346615 242711)
 (symbols 48 72629 6)
 (strings 32 326956 25390)
 (string-bytes 1 11416553)
 (vectors 16 122495)
 (vector-slots 8 2358061 258976)
 (floats 8 5596 2288)
 (intervals 56 234189 8288)
 (buffers 1000 244))

bug#43252: 27.1; DBus properties lack type hints or overrides

[Michael Albinus]

Hugh Daschbach <hugh@ccss.com> writes:

Hi Hugh,

> In order to implement a service exposing interface
> "org.bluez.GattService1", I need to export the properties defined for
> that interface.  (See,
> https://kernel.googlesource.com/pub/scm/bluetooth/bluez/+/refs/tags/5.55/doc/gatt-api.txt)
>
> There are two properties that require an object path: "Device", and
> "Includes".  Since there is no type information associated with the
> registered property, introspection supplies its best guess.  If the
> value is a string it is described as a :string, not an :object-path
>
> There doesn't seem to be any mechanism to register the property and have
> introspection describe it as as an :object-path.
>
> Am I missing something?  Is this out of scope?  Is there anyway to
> specify simple types for parameter values?

Confirmed. In `dbus-registered-objects-table', properties are stored w/o
signature. An object path is stored as string, and dbus-get-property
returns a string.

Introspection data could be used if exists (like in your case). But they
are optional, so one cannot trust on their existence. Maybe we could say
that, in absence of introspection data, ofD.Properties.Get and
ofD.Properties.GetAll shall return a default type, like string in case
of object paths? Then it would be the responsibility of the user to
provide proper introspection data if needed.

> Thanks,
> Hugh

Best regards, Michael.

bug#43252: 27.1; DBus properties lack type hints or overrides

[Hugh Daschbach]

Michael Albinus writes:

> Hugh Daschbach <hugh@ccss.com> writes:
>
> Hi Hugh,
>
>> There doesn't seem to be any mechanism to register the property 
>> and have
>> introspection describe it as as an :object-path.
>>
>
> Confirmed. In `dbus-registered-objects-table', properties are 
> stored w/o
> signature. An object path is stored as string, and 
> dbus-get-property
> returns a string.
>
> Introspection data could be used if exists (like in your 
> case). But they
> are optional, so one cannot trust on their existence. Maybe we 
> could say
> that, in absence of introspection data, ofD.Properties.Get and
> ofD.Properties.GetAll shall return a default type, like string 
> in case
> of object paths? Then it would be the responsibility of the user 
> to
> provide proper introspection data if needed.
>

I had considered an optional or keyword argument to
dbus-register-property, but I like introspection even more.  Then 
the
application simply registers ofD.Introspectable.Introspect for 
each of
its objects?

Introspect returns XML.  The SEXP that dbus-introspect-xml returns 
is
easier to work with.  So do you memoize the returned value?  There 
may
not be enough overhead to be concerned.  I'm just trying to 
imagine what
overhead would be introduced.

I'm looking at emulating a Bluetooth keyboard.  So I'm 
anticipating
bursty property updates on the order of tens per second.  User
initiated, rather than continuous background activity.  But I 
don't want
to bog the system down.  An introspection per property update 
probably
isn't much to worry about.

Sounds good to me.

Cheer,
Hugh

bug#43252: 27.1; DBus properties lack type hints or overrides

[Michael Albinus]

Hugh Daschbach <hugh@ccss.com> writes:

Hi Hugh,

>>> There doesn't seem to be any mechanism to register the property and
>>> have
>>> introspection describe it as as an :object-path.
>>>
>>
>> Confirmed. In `dbus-registered-objects-table', properties are stored
>> w/o
>> signature. An object path is stored as string, and dbus-get-property
>> returns a string.
>>
>> Introspection data could be used if exists (like in your case). But
>> they
>> are optional, so one cannot trust on their existence. Maybe we could
>> say
>> that, in absence of introspection data, ofD.Properties.Get and
>> ofD.Properties.GetAll shall return a default type, like string in
>> case
>> of object paths? Then it would be the responsibility of the user to
>> provide proper introspection data if needed.
>>
>
> I had considered an optional or keyword argument to
> dbus-register-property, but I like introspection even more.  Then the
> application simply registers ofD.Introspectable.Introspect for each of
> its objects?

I'm just sitting at this. Yes, introspection data is the best way to
go. I've already extended dbus-introspect-get-signature to support also
properties (it does already work for methods and signals, modulo a bug I
have fixed this way). Looks promising.

> Introspect returns XML.  The SEXP that dbus-introspect-xml returns is
> easier to work with.

Sure. But there are several helper functions, like the just mentioned
dbus-introspect-get-signature. Have a look at dbus.el; not everything is
documented. (And since I'm bad in documentation; comments for
improvements are appreciated)

> So do you memoize the returned value?  There may not be enough
> overhead to be concerned.  I'm just trying to imagine what overhead
> would be introduced.

Not yet. But in case of performance problems, we could indeed do caching.

> I'm looking at emulating a Bluetooth keyboard.  So I'm anticipating
> bursty property updates on the order of tens per second.  User
> initiated, rather than continuous background activity.  But I don't
> want to bog the system down.  An introspection per property update
> probably isn't much to worry about.

My experience is that method calls are very responsive. But I haven't
tested with bulk data yet, we'll see.

Another problem: The changes I apply do not qualify as bug fixing any
longer, so I fear they are not applicable to Emacs 27. I'm working on
Emacs' master branch (what will be Emacs 28 later), the patches I have
provided to you were backports. Do you have a chance to use Emacs'
master branch? This will avoid discussions with the maintainers whether
those changes are good for Emacs 27, and it will simplify my life
considerably, because the sources for D-Bus in Emacs 27 and 28 differ. I
have even applied changes to dbusbind.c, which means it would be harder
for you to integrate my patches into Emacs 27.

> Cheer,
> Hugh

Best regards, Michael.

bug#43252: 27.1; DBus properties lack type hints or overrides

[Hugh Daschbach]

Michael Albinus writes:

> Hugh Daschbach <hugh@ccss.com> writes:
>
> Hi Hugh,
>
> Another problem: The changes I apply do not qualify as bug 
> fixing any
> longer, so I fear they are not applicable to Emacs 27. I'm 
> working on
> Emacs' master branch (what will be Emacs 28 later), the patches 
> I have
> provided to you were backports. Do you have a chance to use 
> Emacs'
> master branch? This will avoid discussions with the maintainers 
> whether
> those changes are good for Emacs 27, and it will simplify my 
> life
> considerably, because the sources for D-Bus in Emacs 27 and 28 
> differ. I
> have even applied changes to dbusbind.c, which means it would be 
> harder
> for you to integrate my patches into Emacs 27.

This all sounds good.  I'd be happy to move my testing to 
master. I'd
already realized that part of what I depend on won't make it to 
27.

I'll build master this afternoon.

Thanks.
Hugh

bug#43252: 27.1; DBus properties lack type hints or overrides

[Michael Albinus]

Hugh Daschbach <hugh@ccss.com> writes:

Hi Hugh,

>> Another problem: The changes I apply do not qualify as bug fixing any
>> longer, so I fear they are not applicable to Emacs 27. I'm working on
>> Emacs' master branch (what will be Emacs 28 later), the patches I
>> have provided to you were backports. Do you have a chance to use
>> Emacs' master branch? This will avoid discussions with the
>> maintainers whether those changes are good for Emacs 27, and it will
>> simplify my life considerably, because the sources for D-Bus in Emacs
>> 27 and 28 differ. I have even applied changes to dbusbind.c, which
>> means it would be harder for you to integrate my patches into Emacs
>> 27.
>
> This all sounds good.  I'd be happy to move my testing to master. I'd
> already realized that part of what I depend on won't make it to 27.

I've pushed a fix to master, which shall solve the problem. Playing with
introspection, I found the problem that it stalls if there are no
introspection data. Not applicable. So I've turned to the alternative
approach, allowing type symbols in `dbus-set-property' and
`dbus-register-property'. You could call now

(dbus-register-property :session "org.gnu.Emacs" "/node1"
 "org.bluez.GattService1" "Device" :readwrite
 :object-path "/path/node1")

Similar in `dbus-set-property'. Documentation is adapted, dbus-tests.el
extended accordingly.

> I'll build master this afternoon.

Good luck! If everything goes well, could you pls check whther this
problem is solved?

> Thanks.
> Hugh

Best regards, Michael.

bug#43252: 27.1; DBus properties lack type hints or overrides

[Hugh Daschbach]

[-- Attachment #1: Type: text/plain, Size: 1770 bytes --]


Michael Albinus writes:

> Hugh Daschbach <hugh@ccss.com> writes:
>
> Hi Hugh,
>
> I've pushed a fix to master, which shall solve the 
> problem. Playing with
> introspection, I found the problem that it stalls if there are 
> no
> introspection data. Not applicable. So I've turned to the 
> alternative
> approach, allowing type symbols in `dbus-set-property' and
> `dbus-register-property'. You could call now
>
> (dbus-register-property :session "org.gnu.Emacs" "/node1"
>  "org.bluez.GattService1" "Device" :readwrite
>  :object-path "/path/node1")
>
> Similar in `dbus-set-property'. Documentation is adapted, 
> dbus-tests.el
> extended accordingly.

Thanks, Michael.  I think I still have issues.

The attached script generates two boolean properties, then issues 
a
GetManagedObjects method call.  The two properties are not 
returned,
though they are in the registered objects table.

The script also drops an elisp ‘dbus-get-all-managed-objects’ 
request in
the *scratch* buffer.  If I execute that, I get a similar failure 
to
#43251.  That may not be surprising.

I’m working an a more comprehensive test that registers the 
variety of
types I need to support.  I’ll post that when I have something 
worth
looking at.  I’d like to present that in a form compatible with
dbus-test.el rather than throw more one off scripts at you.  So 
give me
a bit.

I think the mechanism you implemented works well for simple types. 
Is
there a mechanism to specify the signature for an empty compound 
type?
I need arrays and dictionaries of various types.

For something like a byte array, I expect I’ll need to interleave 
the
:byte type between each value in the array.  Correct?

Thanks,
Hugh


[-- Attachment #2: GetManagedObjects test. --]
[-- Type: text/plain, Size: 2300 bytes --]

;;; register-property-test.el --- Test program for complex :dict-entry.  -*- lexical-binding: t; -*-

;; Copyright (C) 2020  Hugh Daschbach

;; Author: Hugh Daschbach <hugh@ccss.com>
;; Keywords: tools

;; This program 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.

;; This program 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 this program.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; This program demonstrates an error in handling D-Bus properties
;; interface.
;;

;;; Code:

(require 'dbus)
(dbus-register-service :system "org.gnu.Emacs")

(defun main ()
  (interactive)
  (setq dbus-debug t)
  (setq debug-on-error t)

  ;; Boolean

  (dbus-register-property :system "org.gnu.Emacs"
                          "/org/gnu/Emacs/hci0/dev_45_6d_61_63_73_01/service0002/characteristic0003"
                          "org.bluez.GattCharacteristic1"
                          "Discoverable-untyped" :read nil t)

  (dbus-register-property :system "org.gnu.Emacs"
                          "/org/gnu/Emacs/hci0/dev_45_6d_61_63_73_01/service0002/characteristic0003"
                          "org.bluez.GattCharacteristic1"
                          "Discoverable-typed" :read :boolean nil t)
  
  (sit-for 1)
  (start-process "gmo" "*GMO*"
                  "dbus-send"
                  "--system"
                  "--print-reply"
                  "--type=method_call"
                  "--system"
                  "--dest=org.gnu.Emacs"
                  "/"
                  "org.freedesktop.DBus.ObjectManager.GetManagedObjects")
  (switch-to-buffer "*scratch*")
  (insert "(pp (dbus-get-all-managed-objects :system \"org.gnu.Emacs\" \"/\"))\n")
  (sit-for 1)
  (split-window-right)
  (switch-to-buffer "*GMO*")
  (goto-char (point-min)))

(provide 'register-property-test)

;;; register-property-test.el ends here

bug#43252: 27.1; DBus properties lack type hints or overrides

[Hugh Daschbach]

Hugh Daschbach writes:

> Michael Albinus writes:
>
> Thanks, Michael.  I think I still have issues.
>
> The attached script generates two boolean properties, then 
> issues 
> a GetManagedObjects method call.  The two properties are not 
> returned, though they are in the registered objects table.

My apologies.  I left off the script invocation:

./src/emacs -q -Q --load ~/.config/emacs/register-property-test.el 
--eval "(main)"

> The script also drops an elisp ‘dbus-get-all-managed-objects’ 
> request in
> the *scratch* buffer.  If I execute that, I get a similar 
> failure 
> to #43251.  That may not be surprising.

And please ignore the above paragraph.  That was an operator 
error.

Thanks,
Hugh

bug#43252: 27.1; DBus properties lack type hints or overrides

[Michael Albinus]

Hugh Daschbach <hugh@ccss.com> writes:

Hi Hugh,

> The attached script generates two boolean properties, then issues a
> GetManagedObjects method call.  The two properties are not returned,
> though they are in the registered objects table.

Thanks for the heads up. There was still a small thinko in
dbus-managed-objects-handler which I haven't noticed, because in my
tests I have registered both methods and properties in parallel. I've
pushed a fix to master, including extension of dbus-tests.el (which
shall prevent this problem to reappear silently).

> The script also drops an elisp ‘dbus-get-all-managed-objects’ request
> in
> the *scratch* buffer.  If I execute that, I get a similar failure to
> #43251.  That may not be surprising.

Sure. I haven't worked on this yet.

> I’m working an a more comprehensive test that registers the variety of
> types I need to support.  I’ll post that when I have something worth
> looking at.  I’d like to present that in a form compatible with
> dbus-test.el rather than throw more one off scripts at you.  So give
> me
> a bit.

That would be great! I'll happily add your tests to
dbus-tests.el. However, this would be a contribution to Emacs. For
contributions exceeding ~15 lines, every contributor shall sign the
legal papers from the FSF. Would you be willing to do?

> I think the mechanism you implemented works well for simple types. Is
> there a mechanism to specify the signature for an empty compound type?
> I need arrays and dictionaries of various types.

Until now, the implementation allows only basic D-Bus types for
properties. Nobody has asked for more so far :-)

I could extend this for complex types. Since this will require internal
changes of data structures, it might take some days.

An empty array could be specified by the element's signature, like
(:array :signature "{sv}"). See the D-Bus manual via
(info "(dbus) Type Conversion")

> For something like a byte array, I expect I’ll need to interleave the
> :byte type between each value in the array.  Correct?

Yes.

> Thanks,
> Hugh

Best regards, Michael.

bug#43252: 27.1; DBus properties lack type hints or overrides

[Hugh Daschbach]

Michael Albinus writes:

> Hugh Daschbach <hugh@ccss.com> writes:
>
> Hi Hugh,
>
> That would be great! I'll happily add your tests to
> dbus-tests.el. However, this would be a contribution to 
> Emacs. For
> contributions exceeding ~15 lines, every contributor shall sign 
> the
> legal papers from the FSF. Would you be willing to do?

Yes, I'd be willing to assign copyright to FSF.  Where do I get a 
copy
of the paperwork?  I'll keep submissions to under 15 lines until I 
can
get the paperwork cleared.

> Until now, the implementation allows only basic D-Bus types for
> properties. Nobody has asked for more so far :-)
>
> I could extend this for complex types. Since this will require 
> internal
> changes of data structures, it might take some days.
>
> An empty array could be specified by the element's signature, 
> like
> (:array :signature "{sv}"). See the D-Bus manual via
> (info "(dbus) Type Conversion")

I have used that signature for method returns.  I suppose I could 
save
the signature as a property value instead of nil if I have an 
empty
value for a compound type.  Let me look at that.

Thanks again.

Hugh

bug#43252: 27.1; DBus properties lack type hints or overrides

[Michael Albinus]

Hugh Daschbach <hugh@ccss.com> writes:

Hi Hugh,
>>
>> That would be great! I'll happily add your tests to
>> dbus-tests.el. However, this would be a contribution to Emacs. For
>> contributions exceeding ~15 lines, every contributor shall sign the
>> legal papers from the FSF. Would you be willing to do?
>
> Yes, I'd be willing to assign copyright to FSF.  Where do I get a copy
> of the paperwork?  I'll keep submissions to under 15 lines until I can
> get the paperwork cleared.

FTR, template sent offlist.

> Thanks again.
>
> Hugh

Best regards, Michael.

bug#43252: Fwd: bug#43252: 27.1; DBus properties lack type hints or overrides

[Michael Albinus]

[-- Attachment #0: Type: message/rfc822, Size: 2581 bytes --]

[-- Attachment #1.1: Type: text/plain, Size: 649 bytes --]


Michael Albinus writes:

> Hugh Daschbach <hugh@ccss.com> writes:
>
> Hi Hugh,
>
> Appended. And thanks for your offer!

Thanks, Michael.  I've sent the email requesting the paperwork.
Will
let you know when it's submitted.

In the meantime, just to check that I'm on the right track, I've
attached a failing test.  Sadly, it's more than 15 lines.  Feel
free to
test with it.

For the moment, I'll only forward failing tests.  Once the
paperwork is
finalized I'll send you whatever suite of tests I've managed to
come up
with by then.

Just for the record, I'm testing master currently at d08568e6e92.

Cheers,
Hugh



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: Failing test, registering a property with compound value. --]
[-- Type: text/x-patch, Size: 1372 bytes --]

diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el
index 8b456c3551f..8b79f5ac201 100644
--- a/test/lisp/net/dbus-tests.el
+++ b/test/lisp/net/dbus-tests.el
@@ -520,6 +520,31 @@ dbus-test05-register-property-several-paths
     ;; Cleanup.
     (dbus-unregister-service :session dbus--test-service)))

+(ert-deftest dbus-test06-register-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))
+
+  (unwind-protect
+      (let ((byte-array "ByteArray"))
+        (should
+         (equal
+          (dbus-register-property
+           :session dbus--test-service dbus--test-path
+           dbus--test-interface byte-array :read byte-array '(:array :byte 1 :byte 2 : byte 3))
+          `((:property :session dbus--test-path ,byte-array)
+            (,dbus--test-service ,dbus--test-path))))
+        (should
+         (string-equal
+          (dbus-get-property
+           :session dbus--test-service dbus--test-path
+           dbus--test-interface byte-array)
+          '(1 2 3))))
+
+    ;; Cleanup.
+    (dbus-unregister-service :session dbus--test-service)))
+
+
 (defun dbus-test-all (&optional interactive)
   "Run all tests for \\[dbus]."
   (interactive "p")

bug#43252: 27.1; DBus properties lack type hints or overrides

[Michael Albinus]

Hugh Daschbach <hugh@ccss.com> writes:

Hi Hugh,

> In the meantime, just to check that I'm on the right track, I've
> attached a failing test.  Sadly, it's more than 15 lines.  Feel free
> to test with it.

Thanks.

Reading the BlueZ D-Bus GATT API description, you seem to need only
basic types and arrays of basic types as properties. So I will start
adding arrays of basic types. Other, more complex compound types will
follow later.

> For the moment, I'll only forward failing tests.  Once the paperwork
> is finalized I'll send you whatever suite of tests I've managed to
> come up with by then.

Yep, much appreciated!

> Just for the record, I'm testing master currently at d08568e6e92.

master HEAD is always good, since I'm committing there. I haven't the
impression that we break anybody else; otherwise we would need an own
branch. I would notify if needs arise.

> Cheers,
> Hugh

Best regards, Michael.

bug#43252: 27.1; DBus properties lack type hints or overrides

[Michael Albinus]

[-- Attachment #1: Type: text/plain, Size: 1053 bytes --]

Michael Albinus <michael.albinus@gmx.de> writes:

Hi Hugh,

> Reading the BlueZ D-Bus GATT API description, you seem to need only
> basic types and arrays of basic types as properties. So I will start
> adding arrays of basic types. Other, more complex compound types will
> follow later.

I have pushed my recent work to master. dbus-register-property,
dbus-get-property, dbus-get-all-properties and
dbus-get-all-managed-objects shall work now for your byte
array. dbus-set-property will follow tomorrow, as well as other compound
types but array.

>> For the moment, I'll only forward failing tests.  Once the paperwork
>> is finalized I'll send you whatever suite of tests I've managed to
>> come up with by then.
>
> Yep, much appreciated!

I had to modify your test a little bit, see appended. It passes now for
me. I have renamed it also to dbus-test05-register-property-types, so we
have all property tests under test05, which makes it more easy to select
these tests in batch.

Does it work for you?

>> Cheers,
>> Hugh

Best regards, Michael.


[-- Attachment #2: Type: text/plain, Size: 1523 bytes --]


(ert-deftest dbus-test05-register-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))

  (unwind-protect
      (let ((byte-array "ByteArray"))
        (should
         (equal
          (dbus-register-property
           :session dbus--test-service dbus--test-path
           dbus--test-interface byte-array :read
           '(:array :byte 1 :byte 2 :byte 3))
          `((:property :session ,dbus--test-interface ,byte-array)
            (,dbus--test-service ,dbus--test-path))))
        (should
         (equal
          (dbus-get-property
           :session dbus--test-service dbus--test-path
           dbus--test-interface byte-array)
          '(1 2 3)))

        ;; A test for `dbus-get-property' shall be added.

        (let ((result
               (dbus-get-all-properties
                :session dbus--test-service dbus--test-path
                dbus--test-interface)))
          (should (equal (cdr (assoc byte-array result)) '(1 2 3))))

        (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 byte-array result1)) '(1 2 3)))))

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

bug#43252: 27.1; DBus properties lack type hints or overrides

[Hugh Daschbach]

Michael Albinus writes:

> Michael Albinus <michael.albinus@gmx.de> writes:
>
> I had to modify your test a little bit, see appended. It passes 
> now for
> me. I have renamed it also to 
> dbus-test05-register-property-types, so we
> have all property tests under test05, which makes it more easy 
> to select
> these tests in batch.

Good.  I've not yet developed a good TDD perspective.  So I'm 
likely to
trip over naming and test structure conventions.  I'll learn as we 
go.
Thanks for the feedback.

> Does it work for you?

It does.  I've added a string array test without issue.  I'll add 
a few
more and let you know if/when I come across another failure.

Many thanks.
Hugh

bug#43252: 27.1; DBus properties lack type hints or overrides

[Hugh Daschbach]

[-- Attachment #1: Type: text/plain, Size: 2042 bytes --]


Michael Albinus writes:

> Michael Albinus <michael.albinus@gmx.de> writes:
>
> Hi Hugh,
>
>> Reading the BlueZ D-Bus GATT API description, you seem to need 
>> only
>> basic types and arrays of basic types as properties. So I will 
>> start
>> adding arrays of basic types. Other, more complex compound 
>> types will
>> follow later.

That's mostly true.  There is another BlueZ interface 
(advertising) that
take a byte keyed dictionary.  It isn't obvious from the 
documentation
https://git.kernel.org/pub/scm/bluetooth/bluez.git/tree/doc/advertising-api.txt.
But the Manufacturer ID described mentioned in the 
ManufacturerData
dictionary description is a byte value.

The property table in the BlueZ source code looks like:

	{ "ManufacturerData", "a{qv}", get_manufacturer_data, 
	NULL,
						manufacturer_data_exists 
						},

(https://git.kernel.org/pub/scm/bluetooth/bluez.git/tree/client/advertising.c#n465)

It isn't clear that there's a commitment to support such a data
structure.  The DBus info page says "Every dictionary entry has a 
string
as a key".


> I have pushed my recent work to master. dbus-register-property,
> dbus-get-property, dbus-get-all-properties and
> dbus-get-all-managed-objects shall work now for your byte
> array. dbus-set-property will follow tomorrow, as well as other 
> compound
> types but array.
>

With your latest work, I have successful tests for byte arrays, 
string
arrays, object arrays, boolean arrays, and string keyed 
dictionaries.

I haven't been able to verify property signatures programatically. 
I
have turned on dbus-debug and verified signatures reported by the
message formatter.  I assume introspection is in the queue.  With
introspection, we could extend the tests.

I assume I shouldn't care about tests that fail with debug turned 
on.

WRT byte keyed dictionaries, I've attached a failing test.  I 
don't know
if you want to look at it or not.

Still waiting for a response from assign@gnu.org.  I assume a 
delay of a
few days is to be expected.

Thanks again,
Hugh



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Test DBus byte keyed dictionary property. --]
[-- Type: text/x-patch, Size: 3151 bytes --]

^[[1mdiff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el^[[m
^[[1mindex a8e052efbef..c0e85449a37 100644^[[m
^[[1m--- a/test/lisp/net/dbus-tests.el^[[m
^[[1m+++ b/test/lisp/net/dbus-tests.el^[[m
^[[36m@@ -521,6 +521,56 @@^[[m ^[[mdbus-test05-register-property-several-paths^[[m
     ;; Cleanup.^[[m
     (dbus-unregister-service :session dbus--test-service)))^[[m
 ^[[m
^[[32m+^[[m^[[32m(ert-deftest dbus-test05-register-property-types ()^[[m
^[[32m+^[[m^[[32m  "Check property type preservation for an own service."^[[m
^[[32m+^[[m^[[32m  (skip-unless dbus--test-enabled-session-bus)^[[m
^[[32m+^[[m^[[32m  (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service))^[[m
^[[32m+^[[m
^[[32m+^[[m^[[32m  (unwind-protect^[[m
^[[32m+^[[m^[[32m    (let ((object-array "ByteDictionary")^[[m
^[[32m+^[[m^[[32m          (expected '((8^[[m
^[[32m+^[[m^[[32m                       ("byte eight"))^[[m
^[[32m+^[[m^[[32m                      (16^[[m
^[[32m+^[[m^[[32m                       ("byte sixteen"))^[[m
^[[32m+^[[m^[[32m                      (48^[[m
^[[32m+^[[m^[[32m                       ((8 9 10))))))^[[m
^[[32m+^[[m^[[32m      (should^[[m
^[[32m+^[[m^[[32m       (equal^[[m
^[[32m+^[[m^[[32m        (dbus-register-property^[[m
^[[32m+^[[m^[[32m         :session dbus--test-service dbus--test-path^[[m
^[[32m+^[[m^[[32m         dbus--test-interface object-array :read^[[m
^[[32m+^[[m^[[32m         '(:array^[[m
^[[32m+^[[m^[[32m           :dict-entry (:byte 8 (:variant :string "byte-eight"))^[[m
^[[32m+^[[m^[[32m           :dict-entry (:byte 16 (:variant :object-path "/byte sixteen"))^[[m
^[[32m+^[[m^[[32m           :dict-entry (:byte 48  (:variant (:array :byte 8 :byte 9 :byte 10)))))^[[m
^[[32m+^[[m^[[32m        `((:property :session ,dbus--test-interface ,object-array)^[[m
^[[32m+^[[m^[[32m          (,dbus--test-service ,dbus--test-path))))^[[m
^[[32m+^[[m^[[32m      (should^[[m
^[[32m+^[[m^[[32m       (equal^[[m
^[[32m+^[[m^[[32m        (dbus-get-property^[[m
^[[32m+^[[m^[[32m         :session dbus--test-service dbus--test-path^[[m
^[[32m+^[[m^[[32m         dbus--test-interface object-array)^[[m
^[[32m+^[[m^[[32m        expected))^[[m
^[[32m+^[[m
^[[32m+^[[m
^[[32m+^[[m^[[32m      ;; A test for `dbus-get-property' shall be added.^[[m
^[[32m+^[[m
^[[32m+^[[m^[[32m      (let ((result^[[m
^[[32m+^[[m^[[32m             (dbus-get-all-properties^[[m
^[[32m+^[[m^[[32m              :session dbus--test-service dbus--test-path^[[m
^[[32m+^[[m^[[32m              dbus--test-interface)))^[[m
^[[32m+^[[m^[[32m        (should (equal (cdr (assoc object-array result)) expected)))^[[m
^[[32m+^[[m
^[[32m+^[[m^[[32m      (let ((result^[[m
^[[32m+^[[m^[[32m             (dbus-get-all-managed-objects :session dbus--test-service "/"))^[[m
^[[32m+^[[m^[[32m            result)^[[m
^[[32m+^[[m^[[32m        (should (setq result1 (cadr (assoc dbus--test-path result))))^[[m
^[[32m+^[[m^[[32m        (should (setq result1 (cadr (assoc dbus--test-interface result1))))^[[m
^[[32m+^[[m^[[32m        (should (equal (cdr (assoc object-array result1)) expected))))^[[m
^[[32m+^[[m
^[[32m+^[[m^[[32m    ;; Cleanup.^[[m
^[[32m+^[[m^[[32m    (dbus-unregister-service :session dbus--test-service)))^[[m
^[[32m+^[[m
 (defun dbus-test-all (&optional interactive)^[[m
   "Run all tests for \\[dbus]."^[[m
   (interactive "p")^[[m

bug#43252: 27.1; DBus properties lack type hints or overrides

[Michael Albinus]

Hugh Daschbach <hugh@ccss.com> writes:

Hi Hugh,

>> I had to modify your test a little bit, see appended. It passes now
>> for me. I have renamed it also to
>> dbus-test05-register-property-types, so we have all property tests
>> under test05, which makes it more easy to select these tests in
>> batch.
>
> Good.  I've not yet developed a good TDD perspective.  So I'm likely
> to trip over naming and test structure conventions.  I'll learn as we
> go.  Thanks for the feedback.

These conventions are rather mine, since I've written dbus-tests.el :-)

General conventions are not so many, see test/README.

> Many thanks.
> Hugh

Best regards, Michael.

bug#43252: 27.1; DBus properties lack type hints or overrides

[Michael Albinus]

[-- Attachment #1: Type: text/plain, Size: 700 bytes --]

Hugh Daschbach <hugh@ccss.com> writes:

Hi Hugh,

> WRT byte keyed dictionaries, I've attached a failing test.  I don't
> know if you want to look at it or not.

The failing test includes some failures itself. I've fixed them (see
appended), now it passes w/o any change in dbus.el.

> Still waiting for a response from assign@gnu.org.  I assume a delay of
> a few days is to be expected.

Yes, it takes time. When I ran through the process decades ago,
everything was done by snail mail to and from Europe, because you have
to sign legal papers physically. Now it seems to be possible to sign
electronically, but I don't know how it goes these days.

> Thanks again,
> Hugh

Best regards, Michael.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/x-patch, Size: 1871 bytes --]

(ert-deftest dbus-test05-register-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))

  (unwind-protect
      (let ((object-array "ByteDictionary")
            (expected '((8 ("byte-eight"))
                        (16 ("/byte/sixteen"))
                        (48 ((8 9 10))))))
        (should
         (equal
          (dbus-register-property
           :session dbus--test-service dbus--test-path
           dbus--test-interface object-array :read
           '(: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)))))
          `((:property :session ,dbus--test-interface ,object-array)
            (,dbus--test-service ,dbus--test-path))))
        (should
         (equal
          (dbus-get-property
           :session dbus--test-service dbus--test-path
           dbus--test-interface object-array)
          expected))

        ;; A test for `dbus-get-property' shall be added.

        (let ((result
               (dbus-get-all-properties
                :session dbus--test-service dbus--test-path
                dbus--test-interface)))
          (should (equal (cdr (assoc object-array 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 object-array result1)) expected))))

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

bug#43252: 27.1; DBus properties lack type hints or overrides

[Michael Albinus]

Hugh Daschbach <hugh@ccss.com> writes:

Hi Hugh,

>>> Reading the BlueZ D-Bus GATT API description, you seem to need only
>>> basic types and arrays of basic types as properties. So I will start
>>> adding arrays of basic types. Other, more complex compound types
>>> will follow later.
>
> That's mostly true.  There is another BlueZ interface (advertising)
> that take a byte keyed dictionary.  It isn't obvious from the
> documentation
> https://git.kernel.org/pub/scm/bluetooth/bluez.git/tree/doc/advertising-api.txt.
> But the Manufacturer ID described mentioned in the ManufacturerData
> dictionary description is a byte value.
>
> The property table in the BlueZ source code looks like:
>
> 	{ "ManufacturerData", "a{qv}", get_manufacturer_data, 	NULL,
> 						manufacturer_data_exists
> 						},
>
> (https://git.kernel.org/pub/scm/bluetooth/bluez.git/tree/client/advertising.c#n465)
>
> It isn't clear that there's a commitment to support such a data
> structure.  The DBus info page says "Every dictionary entry has a
> string as a key".

Looks like this has been extended to "Every dictionary entry has a
basic type as a key".

Anyway, my today's commits shall support now all compound types for properties.

> I haven't been able to verify property signatures programatically. I
> have turned on dbus-debug and verified signatures reported by the
> message formatter.  I assume introspection is in the queue.  With
> introspection, we could extend the tests.

I'm no more convinced that introspection is the way to go. What if there
aren't introspection data?

Maybe one could run two processes in parallel to the tests:

--8<---------------cut here---------------start------------->8---
dbus-monitor --session "sender=org.gnu.Emacs.TestDBus"

dbus-monitor --session "destination=org.gnu.Emacs.TestDBus"
--8<---------------cut here---------------end--------------->8---

It shall be possible to analyze their structured output.

> I assume I shouldn't care about tests that fail with debug turned on.

Yes. However, dbus-debug on let's *all* dbus-error errors through, both
internal errors, and the ones arriving from incoming D-Bus error
messages. Sometimes, one wants to see the latter only. So I have added a
defcustom dbus-show-dbus-errors which allows to pass only the incoming
error messages. See the changed dbus-test05-register-property for examples.

> Thanks again,
> Hugh

Best regards, Michael.

bug#43252: 27.1; DBus properties lack type hints or overrides

[Hugh Daschbach]

Michael Albinus writes:

>> It isn't clear that there's a commitment to support such a data
>> structure.  The DBus info page says "Every dictionary entry has 
>> a
>> string as a key".
>
> Looks like this has been extended to "Every dictionary entry has 
> a
> basic type as a key".
>
> Anyway, my today's commits shall support now all compound types 
> for properties.

Excellent.  Will try to submit tests for them.

> Maybe one could run two processes in parallel to the tests:
>
> --8<---------------cut 
> here---------------start------------->8---
> dbus-monitor --session "sender=org.gnu.Emacs.TestDBus"
>
> dbus-monitor --session "destination=org.gnu.Emacs.TestDBus"
> --8<---------------cut 
> here---------------end--------------->8---
>
> It shall be possible to analyze their structured output.

That idea has taken root.  It'll take me a few days to put 
together
reviewable code.  But I've got a good start.

Paperwork arrived today.  Signed and submitted.  I expect it'll 
take a
bit longer before it's administratively complete.

More when I have some signature analysis code for your review. 
It's
complicated enough to deserve its own tests.

Cheers,
Hugh

bug#43252: 27.1; DBus properties lack type hints or overrides

[Michael Albinus]

Hugh Daschbach <hugh@ccss.com> writes:

Hi Hugh,

>> Anyway, my today's commits shall support now all compound types for
>> properties.
>
> Excellent.  Will try to submit tests for them.

I've just finished my work on dbus-set-property. It shall also keep the
type information of the registered property. Because of this, I've
changed the internal structure of dbus-event; for all arguments the
corresponding type information is propagated now.

You might test this. Given you confirm this functionality, I believe we
can close this bug report now.

>> Maybe one could run two processes in parallel to the tests:
>>
>> --8<---------------cut here---------------start------------->8---
>> dbus-monitor --session "sender=org.gnu.Emacs.TestDBus"
>>
>> dbus-monitor --session "destination=org.gnu.Emacs.TestDBus"
>> --8<---------------cut here---------------end--------------->8---
>>
>> It shall be possible to analyze their structured output.
>
> That idea has taken root.  It'll take me a few days to put together
> reviewable code.  But I've got a good start.

Now that we have type information in dbus-event, I'll start next days to
implement org.freedesktop.DBus.Monitoring.BecomeMonitor
<https://dbus.freedesktop.org/doc/dbus-specification.html#bus-messages-become-monitor>. If
this succeeds, we could implement a counterpart to the dbus-monitor
program in Elisp. And you would be able to access this information
programmatically, including all message and signal call / return
arguments and their types. Let's see.

> Paperwork arrived today.  Signed and submitted.  I expect it'll take a
> bit longer before it's administratively complete.

Good. I'll check the copyright.list file next days regularly, in order
to see whether your name appears. That is the indication that the legal
process has finished.

> More when I have some signature analysis code for your review. It's
> complicated enough to deserve its own tests.

Yep. But you could also wait for some few days, whether the
BecomeMonitor work leads to usable results.

> Cheers,
> Hugh

Best regards, Michael.

bug#43252: 27.1; DBus properties lack type hints or overrides

[Hugh Daschbach]

Michael Albinus writes:

> Hugh Daschbach <hugh@ccss.com> writes:
>
> Hi Hugh,
>
> I've just finished my work on dbus-set-property. It shall also 
> keep the
> type information of the registered property. Because of this, 
> I've
> changed the internal structure of dbus-event; for all arguments 
> the
> corresponding type information is propagated now.
>
> You might test this. Given you confirm this functionality, I 
> believe we
> can close this bug report now.

Good.  I'll test and report back.

>>
>> That idea has taken root.  It'll take me a few days to put 
>> together
>> reviewable code.  But I've got a good start.
>
> Now that we have type information in dbus-event, I'll start next 
> days to
> implement org.freedesktop.DBus.Monitoring.BecomeMonitor
> <https://dbus.freedesktop.org/doc/dbus-specification.html#bus-messages-become-monitor>. If
> this succeeds, we could implement a counterpart to the 
> dbus-monitor
> program in Elisp. And you would be able to access this 
> information
> programmatically, including all message and signal call / return
> arguments and their types. Let's see.

Excellent.  I can now parse the output of dbus-monitor.  But 
capturing
asynchronous output and feeding it through an ah-hoc parser seems
fragile.  Capturing type data directly as a monitor is much more 
robust.

There's quite a bit of boiler plate in the property tests.  Do you 
have
an issue with rolling that up in a macro?  Does it make test 
failure
analysis more difficult?

Here's a candidate:

(defmacro dbus-test05-test-property (name value expected)
  `(let ((byte-array ,name))
    (should
     (equal
      (dbus-register-property
       :session dbus--test-service dbus--test-path
       dbus--test-interface ,name :read
       ,value)
      `((:property :session ,,dbus--test-interface ,,name)
        (,dbus--test-service ,,dbus--test-path))))
    (should
     (equal
      (dbus-get-property
       :session dbus--test-service dbus--test-path
       dbus--test-interface ,name)
      ,expected))

    ;; a test for `dbus-get-property' shall be added.

    (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)))))

With the calling sequence something like:

(dbus-test05-test-property
 "bytearray"
 '(:array :byte 1 :byte 2 :byte 3)
 '(1 2 3))

Opinion?

Thanks,
Hugh

bug#43252: 27.1; DBus properties lack type hints or overrides

[Michael Albinus]

Hugh Daschbach <hugh@ccss.com> writes:

Hi Hugh,

>> Now that we have type information in dbus-event, I'll start next
>> days to
>> implement org.freedesktop.DBus.Monitoring.BecomeMonitor
>> <https://dbus.freedesktop.org/doc/dbus-specification.html#bus-messages-become-monitor>. If
>> this succeeds, we could implement a counterpart to the dbus-monitor
>> program in Elisp. And you would be able to access this information
>> programmatically, including all message and signal call / return
>> arguments and their types. Let's see.
>
> Excellent.  I can now parse the output of dbus-monitor.  But capturing
> asynchronous output and feeding it through an ah-hoc parser seems
> fragile.  Capturing type data directly as a monitor is much more
> robust.

Implementation is more complex than expected. Due to its nature,
org.freedesktop.DBus.Monitoring.BecomeMonitor requires another
(parallel) connection to the bus. This is not foreseen yet in dbusbind.c;
will see how it could fly.

What I could provide just now is an implementation which runs in
*another* Emacs instance. This could be used for monitoring only,
because it is another connection to the bus per definition. Are you
interested to get such a partial implementation?

> There's quite a bit of boiler plate in the property tests.  Do you
> have
> an issue with rolling that up in a macro?  Does it make test failure
> analysis more difficult?

No objection. But comments :-)

> Here's a candidate:
>
> (defmacro dbus-test05-test-property (name value expected)
>  `(let ((byte-array ,name))

I wouldn't call the variable "byte-array"; it could be anything during
test. Call it "property" or alike.

>    (should
>     (equal
>      (dbus-register-property
>       :session dbus--test-service dbus--test-path
>       dbus--test-interface ,name :read

I would use access type :readwrite. We want also to test dbus-set-property.

>       ,value)
>      `((:property :session ,,dbus--test-interface ,,name)
>        (,dbus--test-service ,,dbus--test-path))))

What are the double commas good for? Typos?

>    (should
>     (equal
>      (dbus-get-property
>       :session dbus--test-service dbus--test-path
>       dbus--test-interface ,name)
>      ,expected))
>
>    ;; a test for `dbus-get-property' shall be added.

That's my typo - dbus-set-property is meant. And yes, it shall also be
here. So you might need macro arguments value1 expected1 value2 expected2.

>    (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)))))
>
> With the calling sequence something like:
>
> (dbus-test05-test-property
> "bytearray"
> '(:array :byte 1 :byte 2 :byte 3)
> '(1 2 3))
>
> Opinion?

See above.

> Thanks,
> Hugh

Best regards, Michael.

bug#43252: 27.1; DBus properties lack type hints or overrides

[Hugh Daschbach]

Michael Albinus writes:

> Hugh Daschbach <hugh@ccss.com> writes:
>
> Hi Hugh,
>
>>> this succeeds, we could implement a counterpart to the 
>>> dbus-monitor
>>> program in Elisp. And you would be able to access this 
>>> information
>>
>> Excellent.  I can now parse the output of dbus-monitor.  But 
>> capturing
>
> Implementation is more complex than expected. Due to its nature,
> org.freedesktop.DBus.Monitoring.BecomeMonitor requires another
> (parallel) connection to the bus. This is not foreseen yet in 
> dbusbind.c;
> will see how it could fly.
>
> What I could provide just now is an implementation which runs in
> *another* Emacs instance. This could be used for monitoring 
> only,
> because it is another connection to the bus per definition. Are 
> you
> interested to get such a partial implementation?

I'm interested in whatever you want to implement.  I see signature
verification useful for testing rather than an exposed feature.

From what I can see from looking at dbus-monitor output the 
correct
property types are being exposed now.  It seems to be working.

So whatever we approach we take, the benefit is early warning of 
future
regressions.  You are a better judge of benefit of additional 
effort
than I.

A second Emacs instance seems to offer the same asynchronous 
output
gathering issues that dbus-monitor poses.  It does eliminates the 
ad-hoc
parser.

If you have a longer term goal, I'd suggest pursuing that rather 
than
something partial that you'll want to replace later.

But I have no objection to a parallel instance to gather request
signatures.

>>  Do you have
>> an issue with rolling that up in a macro? 
>
> No objection. But comments :-)
>
>> (defmacro dbus-test05-test-property (name value expected)
>>  `(let ((byte-array ,name))
>
> I wouldn't call the variable "byte-array"; it could be anything 
> during
> test. Call it "property" or alike.

Fixed

>>    (should
>>     (equal
>>      (dbus-register-property
>>       :session dbus--test-service dbus--test-path
>>       dbus--test-interface ,name :read
>
> I would use access type :readwrite. We want also to test 
> dbus-set-property.

Yes, I've added a set property test.  I'll move access to a 
parameter so
I can do both positive and negative testing; confirm that :read 
prevents
writes.

Which raises the question, should dbus-set-property function call 
fail
for a local property that isn't :readwrite, or should that only be
prevented by incoming messages?  Do we require that
dbus-register-property be used to update a :read access property.

>>       ,value)
>>      `((:property :session ,,dbus--test-interface ,,name)
>>        (,dbus--test-service ,,dbus--test-path))))
>
> What are the double commas good for? Typos?

I had nested quasi-quoted expressions.  I'm working to avoid that. 
So
that was a bug.

>>    (should
>>     (equal
>>      (dbus-get-property
>>       :session dbus--test-service dbus--test-path
>>       dbus--test-interface ,name)
>>      ,expected))
>>
>>    ;; a test for `dbus-get-property' shall be added.
>
> That's my typo - dbus-set-property is meant. And yes, it shall 
> also be
> here. So you might need macro arguments value1 expected1 value2 
> expected2.

I assumed as much.  I just carried the comment around blindly. 
I've
changed what I sent you to accept a list of pairs of values and 
expected
return sexps.  I use the first pair on the list for
dbus-register-property, verify retrieval, then use 
dbus-set-property to
update and verify the property from the remaining pairs.

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.

Cheers,
Hugh

bug#43252: 27.1; DBus properties lack type hints or overrides

[Hugh Daschbach]

[-- Attachment #1: Type: text/plain, Size: 1518 bytes --]


Hugh Daschbach writes:

> Michael Albinus writes:
>
>> Hugh Daschbach <hugh@ccss.com> 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


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Additional property tests. --]
[-- Type: text/x-patch, Size: 12548 bytes --]

From 722852e9e1d402742508233051951d21b02bc3c9 Mon Sep 17 00:00:00 2001
From: Hugh Daschbach <hdasch@fastmail.com>
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

bug#43252: 27.1; DBus properties lack type hints or overrides

[Michael Albinus]

Hugh Daschbach <hugh@ccss.com> writes:

Hi Hugh,

>> Implementation is more complex than expected. Due to its nature,
>> org.freedesktop.DBus.Monitoring.BecomeMonitor requires another
>> (parallel) connection to the bus. This is not foreseen yet in
>> dbusbind.c;
>> will see how it could fly.
>>
>> What I could provide just now is an implementation which runs in
>> *another* Emacs instance. This could be used for monitoring only,
>> because it is another connection to the bus per definition. Are you
>> interested to get such a partial implementation?
>
> I'm interested in whatever you want to implement.  I see signature
> verification useful for testing rather than an exposed feature.
>
> From what I can see from looking at dbus-monitor output the correct
> property types are being exposed now.  It seems to be working.
>
> So whatever we approach we take, the benefit is early warning of
> future
> regressions.  You are a better judge of benefit of additional effort
> than I.
>
> A second Emacs instance seems to offer the same asynchronous output
> gathering issues that dbus-monitor poses.  It does eliminates the
> ad-hoc
> parser.
>
> If you have a longer term goal, I'd suggest pursuing that rather than
> something partial that you'll want to replace later.
>
> But I have no objection to a parallel instance to gather request
> signatures.

I don't know where we end up. I'm still poking around how to implement a
second connection to the same bus. If it is not too expensive to
implement I'd prefer this.

> Which raises the question, should dbus-set-property function call fail
> for a local property that isn't :readwrite, or should that only be
> prevented by incoming messages?

dbus-set-property doesn't know, whether a property is registered
locally. I guess an error reply is reasonable, whether the property is
registered locally, or not.

> Do we require that dbus-register-property be used to update a :read
> access property.

dbus-set-property shall fail when the property has :read access. Yes,
such a property can be changed only by dbus-register-property. But :read
access is intended to tell the clients, that they shouldn't change the
property; an error in dbus-set-property (returning nil, respectively) is
appropriate.

> Cheers,
> Hugh

Best regards, Michael.

bug#43252: 27.1; DBus properties lack type hints or overrides

[Michael Albinus]

Hugh Daschbach <hugh@ccss.com> 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.

Well, before getting type information in dbus-event, it wasn't possible
for dbus-property-handler to know the types of values provided by
org.freedesktop.DBus.Properties.Set method calls. Therefore I've said,
that the type used in dbus-register-property shall be inherited. This
decision wasn't dictated by the D-Bus API, it was just an implementation
restriction.

Now, that the type information is preserved, I have abandoned this
restriction. You can register a property with any type, and you can
overwrite this property via an ofDP.Set call with a value of any other
type. This is not forbidden by the D-Bus API (but highly discouraged, I
guess).

> In addition, I see a failure in dbus-test04-register-method:
>
>> (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"))

Oops, yes. The intention of this check is to see, whether
org.freedesktop.DBus.Error.ServiceUnknown is reported (it is). The
additional explanation doesn't matter, and it seems to be different
depending on the D-Bus daemon implementation (I'm using Fedora 32).

So I've pushed a fix, which checks just for the D-Bus error name, w/o
the additional text.

> I'm starting to run out of ideas for additional tests. Suggestions
> welcome.

The major black hole seems to be dbus-introspect* tests. If you are
interested? I fear writing them will be boring, so I haven't done them
yet ...

OTOH, they are not the most important part of Emacs' D-Bus implementation.

> Cheers,
> Hugh

Best regards, Michael.

bug#43252: 27.1; DBus properties lack type hints or overrides

[Michael Albinus]

Hugh Daschbach <hugh@ccss.com> writes:

Hi Hugh,

In general, your tests are very useful. Thanks!

Just some comments on your patch.

> Add tests that should fail, like setting a property with a type
> different from it's type at registration time.

As said the other message, this constraint doesn't exist any longer.
Registered services might want to control, which properties are
set. This could be the type of a property, or a restriction of the value
(for example, just a predefined set of strings could be allowed).

Maybe, we give these services such a mean? That is, they could add an
own handler function in dbus-register-property, which is applied when a
org.freedesktop.DBus.Properties.Set method call is handled. WDYT?

> +(defun dbus-test06-make-property-test (selector name value expected)

I would call it dbus--test-make-property-test. test06 isn't important,
and the double slash "--" is an indication that this is an internal
function, which shouldn't leave the dbus-tests.el scope. See the other
helper functions in the file.

> +;; 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.

Well, it is uncommon that a function returns a code snippet. I haven't
checked, but couldn't you achieve your goal by changing this defun into
a defsubst?

> +(defmacro dbus-test06-test-property (name value-list)

Same comment on name here. I would call it dbus--test-property.

> +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'."

The second argument is VALUE-LIST, not VALUES. However, Elisp encourages
an argument list like

(defmacro dbus-test-test-property (name &rest value-list)

This simplifies call conventions, you can call then with several
key-value arguments like

(dbus--test-property
 "ByteArray"
 '((:array :byte 1 :byte 2 :byte 3) . (1 2 3))
 '((:array :byte 4 :byte 5 :byte 6) . (4 5 6)))

> +(defmacro with-dbus-monitor (buffer &rest body)

Such a macro name would poison your Elisp name space. Keep the
dbus--test prefix, and name the macro like dbus--test-with-dbus-monitor.

> +    (unwind-protect
> +        (progn ,@body)
> +      (sit-for 0.5)

sit-for is problematic, because it would delay the test run by 0.5
seconds, unconditionally. People regard this negative, because the
(whole) Emacs test suite shall run fast. A better check might be

(with-timeout (1 (dbus--test-timeout-handler))
  (while (accept-process-output process 0 nil t)))

> +          (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"))))

You might use ,dbus--test-path instead. Here and everywhere else.

> +
> +          (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))

Good question. dbus-set-property and dbus-get-property do not propagate
D-Bus errors. Maybe we shall change the functions to do so? I've asked
this already myself.

> +        ;; 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"))))

Hmm, yes. dbus-register-property does not perform a local type
check. And honestly, I don't want to do it; I let the D-Bus daemon do
the job.

> +        (should-error
> +         (equal
> +          (dbus-get-property
> +           :session dbus--test-service dbus--test-path
> +           dbus--test-interface "MixedArray")
> +          '("/node00" "/node01" "/node0/node02")))

Yes, dbus-get-property is hit by the mismatched types in the :array. Isn't
this sufficient?

> +        (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))

No error expected. You haven't given 1024 a type (like :byte), so it is
handled as :uint32.

> +        ;; 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"))))

Oops. This shall be detected in dbus-register-property.

> Cheers,
> Hugh

Best regards, Michael.

bug#43252: 27.1; DBus properties lack type hints or overrides

[Michael Albinus]

Michael Albinus <michael.albinus@gmx.de> writes:

Hi Hugh,

>> + (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))
>
> No error expected. You haven't given 1024 a type (like :byte), so it is
> handled as :uint32.

And even if you would have prefixed the value with :byte, there won't be
an error. In dbusbind.c, byte values are simply computed by taking the
modulo 255:

	  unsigned char val = XFIXNAT (object) & 0xFF;

":byte 1024" is equal to ":byte 4". Similar conversions happen for the
other basic types, based on numbers.

Maybe we could add some tests for these conversions? Since they are not
restricted to property handling, (a) new test(s) dbus-test01-* would help.

>> Cheers,
>> Hugh

Best regards, Michael.

bug#43252: 27.1; DBus properties lack type hints or overrides

[Hugh Daschbach]

Michael Albinus writes:

> Hugh Daschbach <hugh@ccss.com> writes:
>
> Hi Hugh,

>>  There doesn't seem to be any type checking on property set.
>
> Well, before getting type information in dbus-event, it wasn't 
> possible
> for dbus-property-handler to know the types of values provided 
> by
> org.freedesktop.DBus.Properties.Set method calls. Therefore I've 
> said,
> that the type used in dbus-register-property shall be 
> inherited. This
> decision wasn't dictated by the D-Bus API, it was just an 
> implementation
> restriction.
>
> Now, that the type information is preserved, I have abandoned 
> this
> restriction. You can register a property with any type, and you 
> can
> overwrite this property via an ofDP.Set call with a value of any 
> other
> type. This is not forbidden by the D-Bus API (but highly 
> discouraged, I
> guess).

Makes sense.  I'll adjust tests accordingly.

>> I'm starting to run out of ideas for additional 
>> tests. Suggestions
>> welcome.
>
> The major black hole seems to be dbus-introspect* tests. If you 
> are
> interested? I fear writing them will be boring, so I haven't 
> done them
> yet ...
>
> OTOH, they are not the most important part of Emacs' D-Bus 
> implementation.

I'm willing.  Will have a look.

>> +(defun dbus-test06-make-property-test (selector name value 
>> expected)
>
> I would call it dbus--test-make-property-test. test06 isn't 
> important,
> and the double slash "--" is an indication that this is an 
> internal
> function, which shouldn't leave the dbus-tests.el scope. See the 
> other
> helper functions in the file.

Good by me.  I'll rename accordingly.

>> +;; 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.
>
> Well, it is uncommon that a function returns a code snippet. I 
> haven't
> checked, but couldn't you achieve your goal by changing this 
> defun into
> a defsubst?

Seems like a better approach.  I'm new enough at this that I 
wasn't
aware of defsubst.  I'll give it a go, thanks.

>> +(defmacro dbus-test06-test-property (name value-list)
>
> Same comment on name here. I would call it dbus--test-property.
>
>> +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'."
>
> The second argument is VALUE-LIST, not VALUES. However, Elisp 
> encourages
> an argument list like
>
> (defmacro dbus-test-test-property (name &rest value-list)
>
> This simplifies call conventions, you can call then with several
> key-value arguments like
>
> (dbus--test-property
>  "ByteArray"
>  '((:array :byte 1 :byte 2 :byte 3) . (1 2 3))
>  '((:array :byte 4 :byte 5 :byte 6) . (4 5 6)))
>
>> +(defmacro with-dbus-monitor (buffer &rest body)

Excellent feedback.  Changes incorporated.

> Such a macro name would poison your Elisp name space. Keep the
> dbus--test prefix, and name the macro like 
> dbus--test-with-dbus-monitor.
>
>> +    (unwind-protect
>> +        (progn ,@body)
>> +      (sit-for 0.5)
>
> sit-for is problematic, because it would delay the test run by 
> 0.5
> seconds, unconditionally. People regard this negative, because 
> the
> (whole) Emacs test suite shall run fast. A better check might be
>
> (with-timeout (1 (dbus--test-timeout-handler))
>   (while (accept-process-output process 0 nil t)))

Thanks.  I knew the sit-for was a hack, worse an unpredictable 
hack.

I should have mentioned that I planned to remove the dbus-monitor
wrapper when before final submission.  It's useful for debugging 
the
tests.  But the tests themselves don't need this.

I've folded in your suggestion, but it's scheduled for the 
chopping
block, anyway.

I'm still learning.  Your feedback is most helpful.  Thanks.

>> +          (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"))))
>
> You might use ,dbus--test-path instead. Here and everywhere 
> else.

Good catch.  Thanks.

>> +
>> +          (should                             ; Should this 
>> error instead?
>> +           (equal
>> +            (dbus-set-property
>> ...
>> +             '(:array "seven" "eight" :string "nine"))
>
> Good question. dbus-set-property and dbus-get-property do not 
> propagate
> D-Bus errors. Maybe we shall change the functions to do so? I've 
> asked
> this already myself.

I don't have a strong opinion either way.  I'm just trying to note
corner cases.

>> +        ;; Test mismatched types in array
>> +
>> +        (should                         ; Oddly enough, 
>> register works, but get fails
>> +         (equal
>
> Hmm, yes. dbus-register-property does not perform a local type
> check. And honestly, I don't want to do it; I let the D-Bus 
> daemon do
> the job.

Great.

>> +           dbus--test-interface "MixedArray")
>> +          '("/node00" "/node01" "/node0/node02")))
>
> Yes, dbus-get-property is hit by the mismatched types in the 
> :array. Isn't
> this sufficient?

It is.  As long as we can predict where errors will be reported. 
I'll
update comments to indicate intended behavior.

>> +        (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))
>
> No error expected. You haven't given 1024 a type (like :byte), 
> so it is
> handled as :uint32.

Cool.  With the explanation regarding dbus-set-property changing
types, this makes perfect sense.

> And even if you would have prefixed the value with :byte, there 
> won't be
> an error. In dbusbind.c, byte values are simply computed by 
> taking the
> modulo 255:
>
> 	  unsigned char val = XFIXNAT (object) & 0xFF;
>
> ":byte 1024" is equal to ":byte 4". Similar conversions happen 
> for the
> other basic types, based on numbers.

Good.  I haven't thought deeply enough about DBus to anticipate
truncation.  I've added a test for this, an extract of which is 
below.
The get returns nil instead of 4.  I can change the expected 
value, but
wanted to run this by you first.

> Maybe we could add some tests for these conversions? Since they 
> are not
> restricted to property handling, (a) new test(s) dbus-test01-* 
> would help.

I'll have a look.

>>> Implementation is more complex than expected. Due to its 
>>> nature,

>> But I have no objection to a parallel instance to gather 
>> request
>> signatures.
>
> I don't know where we end up. I'm still poking around how to 
> implement a
> second connection to the same bus. If it is not too expensive to
> implement I'd prefer this.

Fair enough.  Your call.

>> Which raises the question, should dbus-set-property function 
>> call fail
>> for a local property that isn't :readwrite, or should that only 
>> be
>> prevented by incoming messages?
>
> dbus-set-property doesn't know, whether a property is registered
> locally. I guess an error reply is reasonable, whether the 
> property is
> registered locally, or not.

Would be nice.  Unless it adds overhead, like an introspection.

>> Do we require that dbus-register-property be used to update a 
>> :read
>> access property.
>
> dbus-set-property shall fail when the property has :read 
> access. Yes,
> such a property can be changed only by 
> dbus-register-property. But :read
> access is intended to tell the clients, that they shouldn't 
> change the
> property; an error in dbus-set-property (returning nil, 
> respectively) is
> appropriate.

Cool.


I mentioned an additional test above.  The get below, extracted 
from
the larger test, returns nil instead of 4:

(ert-deftest dbus-test-ad-hoc ()
  (dbus-ignore-errors (dbus-unregister-service :session 
  dbus--test-service))
  (dbus-register-service :session dbus--test-service)
  (should                         ; Test value truncation
   (equal
    (dbus-register-property
     :session dbus--test-service dbus--test-path
     dbus--test-interface "ByteValue" :read :byte 1024)
    `((:property :session ,dbus--test-interface "ByteValue")
      (,dbus--test-service ,dbus--test-path))))

  (should                       ; Returns 0 instead of 4.
   (equal
    (dbus-get-property
     :session dbus--test-service dbus--test-path
     dbus--test-interface "ByteValue")
    4))

  (dbus-unregister-service :session dbus--test-service))

Should I update the expectation to zero?

> Best regards, Michael.


Cheers,
Hugh

bug#43252: 27.1; DBus properties lack type hints or overrides

[Michael Albinus]

Hugh Daschbach <hugh@ccss.com> writes:

Hi Hugh,

>>> +
>>> +          (should                             ; Should this error
>>> instead?
>>> +           (equal
>>> +            (dbus-set-property
>>> ...
>>> +             '(:array "seven" "eight" :string "nine"))
>>
>> Good question. dbus-set-property and dbus-get-property do not
>> propagate
>> D-Bus errors. Maybe we shall change the functions to do so? I've
>> asked
>> this already myself.
>
> I don't have a strong opinion either way.  I'm just trying to note
> corner cases.

Well, I have adapted dbus-set-property and dbus-get-property to
propagate the errors.

>>> +        ;; Test mismatched types in array
>>> +
>>> +        (should                         ; Oddly enough, register
>>> works, but get fails
>>> +         (equal
>>
>> Hmm, yes. dbus-register-property does not perform a local type
>> check. And honestly, I don't want to do it; I let the D-Bus daemon
>> do
>> the job.
>
> Great.

Should be checked now. When dbus-register-property is called, it applies
internally a dbus-set-property or dbus-get-property now. As side effect,
the value is checked by the D-Bus daemon, and you shall see errors.

>> And even if you would have prefixed the value with :byte, there
>> won't be
>> an error. In dbusbind.c, byte values are simply computed by taking
>> the
>> modulo 255:
>>
>> 	  unsigned char val = XFIXNAT (object) & 0xFF;
>>
>> ":byte 1024" is equal to ":byte 4". Similar conversions happen for
>> the
>> other basic types, based on numbers.
>
> Good.  I haven't thought deeply enough about DBus to anticipate
> truncation.  I've added a test for this, an extract of which is below.
> The get returns nil instead of 4.  I can change the expected value,
> but
> wanted to run this by you first.

Of course I'm wrong, ":byte 1024" shall be the same as "byte 0".

> (ert-deftest dbus-test-ad-hoc ()
>  (dbus-ignore-errors (dbus-unregister-service :session
>  dbus--test-service))
>  (dbus-register-service :session dbus--test-service)
>  (should                         ; Test value truncation
>   (equal
>    (dbus-register-property
>     :session dbus--test-service dbus--test-path
>     dbus--test-interface "ByteValue" :read :byte 1024)
>    `((:property :session ,dbus--test-interface "ByteValue")
>      (,dbus--test-service ,dbus--test-path))))
>
>  (should                       ; Returns 0 instead of 4.
>   (equal
>    (dbus-get-property
>     :session dbus--test-service dbus--test-path
>     dbus--test-interface "ByteValue")
>    4))

Of course 0. As said, I was wrong.

>  (dbus-unregister-service :session dbus--test-service))
>
> Should I update the expectation to zero?

Yes, please.

> Cheers,
> Hugh

Best regards, Michael.

bug#43252: 27.1; DBus properties lack type hints or overrides

[Michael Albinus]

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.

bug#43252: 27.1; DBus properties lack type hints or overrides

[Hugh Daschbach]

[-- Attachment #1: Type: text/plain, Size: 943 bytes --]


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



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Candidate patch for additional property tests. --]
[-- Type: text/x-patch, Size: 10309 bytes --]

From f3f1f07d94676a22842b04a050231639edf2ec29 Mon Sep 17 00:00:00 2001
From: Hugh Daschbach <hdasch@fastmail.com>
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


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: First cut approximation of Introspection tests. --]
[-- Type: text/x-patch, Size: 14700 bytes --]

From 41ad18f0094740220d5df62c656dc09cf4c18c97 Mon Sep 17 00:00:00 2001
From: Hugh Daschbach <hdasch@fastmail.com>
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."
+  "<?xml version=\"1.0\"?>
+<!DOCTYPE node PUBLIC \"-//freedesktop//DTD D-BUS Object Introspection 1.0//EN\" \"http://www.freedesktop.org/standards/dbus/1.0/introspect.dtd\">
+<node>
+  <interface name=\"org.freedesktop.DBus.Introspectable\">
+    <method name=\"Introspect\">
+      <arg name=\"xml\" type=\"s\" direction=\"out\"/>
+    </method>
+  </interface>
+  <interface name=\"org.freedesktop.DBus.Properties\">
+    <method name=\"Get\">
+      <arg name=\"interface\" type=\"s\" direction=\"in\"/>
+      <arg name=\"name\" type=\"s\" direction=\"in\"/>
+      <arg name=\"value\" type=\"v\" direction=\"out\"/>
+    </method>
+    <method name=\"Set\">
+      <arg name=\"interface\" type=\"s\" direction=\"in\"/>
+      <arg name=\"name\" type=\"s\" direction=\"in\"/>
+      <arg name=\"value\" type=\"v\" direction=\"in\"/>
+    </method>
+    <method name=\"GetAll\">
+      <arg name=\"interface\" type=\"s\" direction=\"in\"/>
+      <arg name=\"properties\" type=\"a{sv}\" direction=\"out\"/>
+    </method>
+    <signal name=\"PropertiesChanged\">
+      <arg name=\"interface\" type=\"s\"/>
+      <arg name=\"changed_properties\" type=\"a{sv}\"/>
+      <arg name=\"invalidated_properties\" type=\"as\"/>
+    </signal>
+  </interface>
+  <interface name=\"org.gnu.Emacs.TestDBus.Interface\">
+    <method name=\"Connect\">
+      <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\"/>
+    </method>
+    <method name=\"DeprecatedMethod0\">
+      <annotation name=\"org.freedesktop.DBus.Deprecated\" value=\"true\"/>
+    </method>
+    <method name=\"DeprecatedMethod1\">
+      <annotation name=\"org.freedesktop.DBus.Deprecated\" value=\"true\"/>
+    </method>
+    <property name=\"Connected\" type=\"b\" access=\"read\"/>
+    <property name=\"Player\" type=\"o\" access=\"read\"/>
+    <annotation name=\"org.freedesktop.DBus.Deprecated\" value=\"true\"/>
+  </interface>
+  <node name=\"node0\"/>
+  <node name=\"node1\"/>
+</node>
+")
+
+(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

bug#43252: 27.1; DBus properties lack type hints or overrides

[Michael Albinus]

Hugh Daschbach <hugh@ccss.com> writes:

Hi Hugh,

> 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.

Thanks for this. AFAICS, there's nothing left open for bug#43252; I'd
like to close it. Is this OK for you?

> And, of course, let me know what you think should be reworked.

There are only some nits left to comment.

> Add DBus tests to validate property handling.  Includes cycling

We call this beast D-Bus, with a hyphen. Here and everywhere in the
docstrings and comments.

> 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.

We add also a ChangeLog style entry to the commit message, see the git
log of dbus-tests.el.

> +The argument SELECTOR indicates whether the test should expand to
> +'dbus-register-property' (if SELECTOR is 'register) or

`dbus-register' (if SELECTOR is `register') or

> +(ert-deftest dbus-test06-test-property-types ()

The "-test" part of the name seems to be superfluous; I'd call it
dbus-test06-property-types. (You see, just nitpicks :-)

> +        (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))))

This is one possibility to declare a :dict-entry. The other possibility,
with the same result, is

'((: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))))
...

Do you mind to test both?

> +        (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))

The error happens in dbus-set-property. No need to test further for
equal. So you could do

(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")))

Furthermore, you could test which error is raised (should-error allows
this). Something like

(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)

Similar approach for your other should-error forms.

> +        ;; Test integer overflow

I don't see any integer *overflow* in the following tests.

> Thanks,
> Hugh

Best regards, Michael.

bug#43252: 27.1; DBus properties lack type hints or overrides

[Michael Albinus]

Hugh Daschbach <hugh@ccss.com> writes:

Hi Hugh,

> 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.

Thanks for this!

It is already very comprehensive (and takes 2 seconds on my laptop, more
than all other tests together). So I guess we could take it as is, until
new tests are triggered by errors in the wild.

OTOH, I don't mind to give this test the :expensive-test tag. Then it
doesn't matter how long it runs.

Given the time it consumes, there might be a need to cache introspection
data. Either the result of dbus-introspect or dbus--parse-xml-buffer, I
guess rather the latter. Do you want to investigate it in dbus.el?

> And, of course, let me know what you think should be reworked.

Here we are. I don't repeat general comments I have given the other review.

> +(defun dbus--test-introspect ()
> +  "Return test introspection string."
> +  "<?xml version=\"1.0\"?>

...

Well, this is one approach. Alternatively, we could regard the
introspection file as test data, which is located in a file called
.../test/lisp/net/dbus-tests/org.gnu.Emacs.TestDBus.xml. This function
(the handler for the Introspect method) would read the file, and return
its contents.

> +(defsubst dbus--test-examine-interface (iface-name
> +                                        expected-properties
> +                                        expected-methods
> +                                        expected-signals
> +                                        expected-annotations)

This is rather C-style of argument indentation. In ELisp, we do
something like

(defsubst dbus--test-examine-interface
  (iface-name expected-properties expected-methods
   expected-signals expected-annotations)
...)

> +  (let ((interface (dbus-introspect-get-interface
> +                    :session
> +                    dbus--test-service
> +                    dbus--test-path
> +                    iface-name)))

A similar comment applies.

> +    (should-not (equal expected nil))

This is (should expected)

> +  (unwind-protect
> +      ;; dbus-introspect-get-node-names
> +      (should
> +       (equal
> +        (dbus-introspect-get-node-names :session dbus--test-service dbus--test-path)
> +        '("node0" "node1")))

A (progn ... is missing after unwind-protect.

> +       '("org.freedesktop.DBus.Deprecated")))

Hmm. Maybe we shall give "org.freedesktop.DBus.Deprecated" a defconst in
dbus.el?

> Thanks,
> Hugh

Best regards, Michael.

bug#43252: 27.1; DBus properties lack type hints or overrides

[Hugh Daschbach]

Michael Albinus writes:

> Hugh Daschbach <hugh@ccss.com> writes:
>
> Hi Hugh,
>
> Thanks for this. AFAICS, there's nothing left open for 
> bug#43252; I'd
> like to close it. Is this OK for you?

Yes.  I was about to suggest this.  The issue is resoled.

>> And, of course, let me know what you think should be reworked.
>
> There are only some nits left to comment.

Good.  Nits promote quality and consistency.

>> Add DBus tests to validate property handling.  Includes cycling
>
> We call this beast D-Bus, with a hyphen. Here and everywhere in 
> the
> docstrings and comments.

Good.  Fixed.

>
> We add also a ChangeLog style entry to the commit message, see 
> the git
> log of dbus-tests.el.

I've taken a shot at this.  I'm not sure I got the ChangeLog style
correct.  Let me know if I'm still off the beaten path.

> `dbus-register' (if SELECTOR is `register') or

Fixed.

>> +(ert-deftest dbus-test06-test-property-types ()
>
> The "-test" part of the name seems to be superfluous; I'd call 
> it
> dbus-test06-property-types. (You see, just nitpicks :-)

You say that as if were a bad thing :-).

Fixed.

>> +        (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))))
>
> This is one possibility to declare a :dict-entry. The other 
> possibility,
> with the same result, is
>
> '((: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))))
> ...
>
> Do you mind to test both?

I seem to consistently stumble over compound type syntax.  Thanks 
for
point this out.  Both forms are now tested.

>> +        (should-error                   ; Cannot set property 
>> with :read access
>> +         (equal ...))
>
> The error happens in dbus-set-property. No need to test further 
> for
> equal. So you could do
>
> (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")))
>
> Furthermore, you could test which error is raised (should-error 
> allows
> this). Something like
>
> (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)
>
> Similar approach for your other should-error forms.

Got it.  I think I've fixed each should-error test.

>> +        ;; Test integer overflow
>
> I don't see any integer *overflow* in the following tests.

Yes, really botched that.  I had a byte truncation test that I 
only now
realize isn't treated as an integer.  And that wasn't near the 
comment.
Sigh.

I've added conforming and overflow tests.  The overflow test,
appropriately, error on register.

> OTOH, I don't mind to give this test the :expensive-test 
> tag. Then it
> doesn't matter how long it runs.

Done.

> Given the time it consumes, there might be a need to cache 
> introspection
> data. Either the result of dbus-introspect or 
> dbus--parse-xml-buffer, I
> guess rather the latter. Do you want to investigate it in 
> dbus.el?

Sure.  I'll have a look.  If I find something useful, I'll open 
another
bug.

>> And, of course, let me know what you think should be reworked.
>
> Here we are. I don't repeat general comments I have given the 
> other review.
>
>> +(defun dbus--test-introspect ()
>> +  "Return test introspection string."
>> +  "<?xml version=\"1.0\"?>
>
> ...
>
> Well, this is one approach. Alternatively, we could regard the
> introspection file as test data, which is located in a file 
> called
> .../test/lisp/net/dbus-tests/org.gnu.Emacs.TestDBus.xml. This 
> function
> (the handler for the Introspect method) would read the file, and 
> return
> its contents.

Makes sense.  Done.

>> +(defsubst dbus--test-examine-interface (iface-name
>> +                                        expected-properties
>> +                                        expected-methods
>> +                                        expected-signals
>> +                                        expected-annotations)
>
> This is rather C-style of argument indentation. In ELisp, we do
> something like

Guilty as charged.  I'm still working on developing idiomatic 
elisp.

> (defsubst dbus--test-examine-interface
>   (iface-name expected-properties expected-methods
>    expected-signals expected-annotations)
> ...)
>
>> +  (let ((interface (dbus-introspect-get-interface
>> +                    :session
>> +                    dbus--test-service
>> +                    dbus--test-path
>> +                    iface-name)))
>
> A similar comment applies.

Is:

(let* ((property
          (dbus-introspect-get-property
           :session
           dbus--test-service
           dbus--test-path interface
           property-name))) ...)

preferred over:

(let* ((property
          (dbus-introspect-get-property :session 
          dbus--test-service
           dbus--test-path interface property-name)))
    ...)

If not, I'll take another bite at the apple.

>> +    (should-not (equal expected nil))
>
> This is (should expected)

Yes, I should read what I write.  Fixed.  Thanks.

>> +  (unwind-protect
>> +      ;; dbus-introspect-get-node-names
>> +      (should
>> +       (equal
>> +        (dbus-introspect-get-node-names :session 
>> dbus--test-service dbus--test-path)
>> +        '("node0" "node1")))
> A (progn ... is missing after unwind-protect.

I really should be more careful when I rip out instrumentation. 
Thanks
for catching this.

>> +       '("org.freedesktop.DBus.Deprecated")))
>
> Hmm. Maybe we shall give "org.freedesktop.DBus.Deprecated" a 
> defconst in
> dbus.el?

Done.  ’dbus-annotation-deprecated’.  Let me know if you think 
this should be
‘dbus--annotation-deprecated’ instead.

>> Thanks,
>> Hugh
>
> Best regards, Michael.

In other news, this test:

  (should-error
   (dbus-check-arguments :session dbus--test-service :unix-fd 10)
   :type 'dbus-error)

works for me in batch mode, but not interactive mode.

On GNU/Linux, (dired (format "/proc/%s/fd" (emacs-pid))) indicates 
I
have 14 open file descriptors on a test instance (emacs -q -Q). 
On my
development instance, I've got 27 open file descriptors.

Cheers,
Hugh

bug#43252: 27.1; DBus properties lack type hints or overrides

[Hugh Daschbach]

[-- Attachment #1: Type: text/plain, Size: 332 bytes --]


Hugh Daschbach writes:

> Michael Albinus writes:
>
>> Hugh Daschbach <hugh@ccss.com> writes:
>>
>> Hi Hugh,
>>
>> Thanks for this. AFAICS, there's nothing left open for 
>> bug#43252; I'd
>> like to close it. Is this OK for you?
>
> Yes.  I was about to suggest this.  The issue is resoled.

Sigh.  Forgot to attach new patches.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Property tests. --]
[-- Type: text/x-patch, Size: 15528 bytes --]

From be45a75b315e56649fa9e39d199fe5e2b50bf69d Mon Sep 17 00:00:00 2001
From: Hugh Daschbach <hdasch@fastmail.com>
Date: Tue, 22 Sep 2020 19:36:20 -0700
Subject: [PATCH 1/2] Add D-Bus property tests.

* test/lisp/net/dbus-tests.el: Add property tests.
(dbus--test-run-property-test) (dbus--test-property)
(dbus-test06-property-types): Test property registration, set, get.
---
 test/lisp/net/dbus-tests.el | 431 ++++++++++++++++++++++++++++++++++++
 1 file changed, 431 insertions(+)

diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el
index 62ed3f2bfb4..543b7c8a95b 100644
--- a/test/lisp/net/dbus-tests.el
+++ b/test/lisp/net/dbus-tests.el
@@ -1004,6 +1004,437 @@ 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 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-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
+         (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
+         (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.
+
+
+    (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


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: Introspection tests. --]
[-- Type: text/x-patch, Size: 15848 bytes --]

From 3efb1b38d75572b14ac0526dbd79769d6fa89d10 Mon Sep 17 00:00:00 2001
From: Hugh Daschbach <hdasch@fastmail.com>
Date: Mon, 21 Sep 2020 17:12:49 -0700
Subject: [PATCH 2/2] Add D-Bus Introspection tests.

* lisp/net/dbus.el (new defconst): D-Bus deprecation name.

* test/lisp/net/dbus-tests.el  (dbus--tests-dir)
(dbus--test-introspect) (dbus--test-examine-interface)
(dbus--test-validate-annotations) (dbus--test-validate-property)
(dbus--test-validate-m-or-s) (dbus--test-validate-signal)
(dbus--test-validate-method) (dbus-test07-introspection): new tests.

* test/lisp/net/dbus-tests/org.gnu.Emacs.TestDBus.xml: new test data.
---
 lisp/net/dbus.el                              |   4 +
 test/lisp/net/dbus-tests.el                   | 324 ++++++++++++++++++
 .../net/dbus-tests/org.gnu.Emacs.TestDBus.xml |  49 +++
 3 files changed, 377 insertions(+)
 create mode 100644 test/lisp/net/dbus-tests/org.gnu.Emacs.TestDBus.xml

diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el
index 86db7cbf18a..8da3245800b 100644
--- a/lisp/net/dbus.el
+++ b/lisp/net/dbus.el
@@ -153,6 +153,10 @@ dbus-interface-local
 ;;   </signal>
 ;; </interface>
 
+(defconst dbus-annotation-deprecated (concat dbus-interface-dbus ".Deprecated")
+  "An annotation value indicating a deprecated interface, method, signal, or property.")
+
+
 \f
 ;;; Default D-Bus errors.
 
diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el
index 543b7c8a95b..15d80f79a22 100644
--- a/test/lisp/net/dbus-tests.el
+++ b/test/lisp/net/dbus-tests.el
@@ -44,6 +44,13 @@ dbus--test-path
 (defconst dbus--test-interface "org.gnu.Emacs.TestDBus.Interface"
   "Test interface.")
 
+(defvar dbus--tests-dir
+  (file-truename
+   (expand-file-name "dbus-tests"
+                     (file-name-directory (or load-file-name
+                                              buffer-file-name))))
+  "Directory containing test data files.")
+
 (defun dbus--test-availability (bus)
   "Test availability of D-Bus BUS."
   (should (dbus-list-names bus))
@@ -1435,6 +1442,323 @@ dbus-test06-property-types
     (message "cleanup")
     (dbus-unregister-service :session dbus--test-service)))
 
+(defun dbus--test-introspect ()
+  "Return test introspection string."
+  (with-temp-buffer
+    (insert-file (expand-file-name "org.gnu.Emacs.TestDBus.xml" dbus--tests-dir))
+    (buffer-string)))
+
+(defsubst dbus--test-validate-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))))))
+
+(defsubst dbus--test-validate-annotations (annotations expected-annotations)
+  "Validate a list of D-Bus 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-validate-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 expected)
+
+    (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-validate-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-validate-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-introspection ()
+  :tags '(:expensive-test)
+  "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
+      (progn
+        ;; 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-validate-interface
+           dbus-interface-introspectable
+           nil
+           '("Introspect")
+           nil
+           nil)
+
+          ;; dbus-introspect-get-interface via `dbus--test-validate-interface'
+          (dbus--test-validate-interface
+           dbus-interface-properties
+           nil '("Get" "Set" "GetAll") '("PropertiesChanged") nil)
+
+          (dbus--test-validate-interface
+           dbus--test-interface
+           '("Connected" "Player")
+           '("Connect" "DeprecatedMethod0" "DeprecatedMethod1")
+           nil
+           `(,dbus-annotation-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-validate-method
+
+          (dbus--test-validate-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-validate-method
+           dbus--test-interface
+           "DeprecatedMethod0"
+           `(,dbus-annotation-deprecated))
+
+          (dbus--test-validate-method
+           dbus--test-interface
+           "DeprecatedMethod1"
+           `(,dbus-annotation-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-validate-signal
+          (dbus--test-validate-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-validate-property
+          (dbus--test-validate-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")
diff --git a/test/lisp/net/dbus-tests/org.gnu.Emacs.TestDBus.xml b/test/lisp/net/dbus-tests/org.gnu.Emacs.TestDBus.xml
new file mode 100644
index 00000000000..620f10510f2
--- /dev/null
+++ b/test/lisp/net/dbus-tests/org.gnu.Emacs.TestDBus.xml
@@ -0,0 +1,49 @@
+<?xml version="1.0"?>
+<!DOCTYPE node PUBLIC "-//freedesktop//DTD D-BUS Object Introspection 1.0//EN" "http://www.freedesktop.org/standards/dbus/1.0/introspect.dtd">
+<node>
+  <interface name="org.freedesktop.DBus.Introspectable">
+    <method name="Introspect">
+      <arg name="xml" type="s" direction="out"/>
+    </method>
+  </interface>
+  <interface name="org.freedesktop.DBus.Properties">
+    <method name="Get">
+      <arg name="interface" type="s" direction="in"/>
+      <arg name="name" type="s" direction="in"/>
+      <arg name="value" type="v" direction="out"/>
+    </method>
+    <method name="Set">
+      <arg name="interface" type="s" direction="in"/>
+      <arg name="name" type="s" direction="in"/>
+      <arg name="value" type="v" direction="in"/>
+    </method>
+    <method name="GetAll">
+      <arg name="interface" type="s" direction="in"/>
+      <arg name="properties" type="a{sv}" direction="out"/>
+    </method>
+    <signal name="PropertiesChanged">
+      <arg name="interface" type="s"/>
+      <arg name="changed_properties" type="a{sv}"/>
+      <arg name="invalidated_properties" type="as"/>
+    </signal>
+  </interface>
+  <interface name="org.gnu.Emacs.TestDBus.Interface">
+    <method name="Connect">
+      <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"/>
+    </method>
+    <method name="DeprecatedMethod0">
+      <annotation name="org.freedesktop.DBus.Deprecated" value="true"/>
+    </method>
+    <method name="DeprecatedMethod1">
+      <annotation name="org.freedesktop.DBus.Deprecated" value="true"/>
+    </method>
+    <property name="Connected" type="b" access="read"/>
+    <property name="Player" type="o" access="read"/>
+    <annotation name="org.freedesktop.DBus.Deprecated" value="true"/>
+  </interface>
+  <node name="node0"/>
+  <node name="node1"/>
+</node>
-- 
2.28.0


[-- Attachment #4: Type: text/plain, Size: 15 bytes --]


Cheers,
Hugh

bug#43252: 27.1; DBus properties lack type hints or overrides

[Michael Albinus]

Hugh Daschbach <hugh@ccss.com> writes:

Hi Hugh,

>> Thanks for this. AFAICS, there's nothing left open for bug#43252; I'd
>> like to close it. Is this OK for you?
>
> Yes.  I was about to suggest this.  The issue is resoled.

Closed.

> Cheers,
> Hugh

Best regards, Michael.

bug#43252: 27.1; DBus properties lack type hints or overrides

[Michael Albinus]

Hugh Daschbach <hugh@ccss.com> writes:

Hi Hugh,

> I've taken a shot at this.  I'm not sure I got the ChangeLog style
> correct.  Let me know if I'm still off the beaten path.

Almost. See comment below.

>> `dbus-register' (if SELECTOR is `register') or
>
> Fixed.

Almost. See comment below.

>> Well, this is one approach. Alternatively, we could regard the
>> introspection file as test data, which is located in a file called
>> .../test/lisp/net/dbus-tests/org.gnu.Emacs.TestDBus.xml. This
>> function (the handler for the Introspect method) would read the file,
>> and return its contents.

Oops, I'm mistaken here. The directory shall be called dbus-resources,
see .../test/file-organization.org. Sorry.

> Is:
>
> (let* ((property
>          (dbus-introspect-get-property
>           :session
>           dbus--test-service
>           dbus--test-path interface
>           property-name))) ...)
>
> preferred over:
>
> (let* ((property
>          (dbus-introspect-get-property :session
>          dbus--test-service
>           dbus--test-path interface property-name)))
>    ...)
>
> If not, I'll take another bite at the apple.

I'd vote for the latter, with the first argument :session preceding
the other arguments in the same line. Like

(let* ((property
        (dbus-introspect-get-property
	 :session dbus--test-service
	 dbus--test-path interface property-name)))
   ...)

If all arguments fit into 80 columns, do it.

The "canonical" formatting is offered by the `pp' command (pretty
printer). I must confess, that I do not follow all its recommendations.

> Done.  ’dbus-annotation-deprecated’.  Let me know if you think this
> should be
> ‘dbus--annotation-deprecated’ instead.

No, the former is OK. People might want to use it in their packages.

> In other news, this test:
>
>  (should-error
>   (dbus-check-arguments :session dbus--test-service :unix-fd 10)
>   :type 'dbus-error)
>
> works for me in batch mode, but not interactive mode.
>
> On GNU/Linux, (dired (format "/proc/%s/fd" (emacs-pid))) indicates I
> have 14 open file descriptors on a test instance (emacs -q -Q). On my
> development instance, I've got 27 open file descriptors.

I see. Will investigate.

And now my review for the latest patch versions.

> From be45a75b315e56649fa9e39d199fe5e2b50bf69d Mon Sep 17 00:00:00 2001
> From: Hugh Daschbach <hdasch@fastmail.com>
> Date: Tue, 22 Sep 2020 19:36:20 -0700
> Subject: [PATCH 1/2] Add D-Bus property tests.
>
> * test/lisp/net/dbus-tests.el: Add property tests.
> (dbus--test-run-property-test) (dbus--test-property)
> (dbus-test06-property-types): Test property registration, set, get.

If you have one comment for several functions, use only one parenthesis
per line like

(dbus--test-run-property-test, dbus--test-property)
(dbus-test06-property-types): Test property registration, set, get.

> +(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-register-property' (if SELECTOR is `register') or

> +         '((:array
> +            :object-path "/node00"
> +            :object-path "/node01"
> +            :object-path "/node0/node02") .
> +            ("/node00" "/node01" "/node0/node02"))

If a cons cell doesn't fit into one line, you shall move the dot "." to
the beginning of the next line, like

(dbus--test-property
 "ObjectArray"
 '((:array
    :object-path "/node00"
    :object-path "/node01"
    :object-path "/node0/node02")
   . ("/node00" "/node01" "/node0/node02"))

I bet the dot "." has the font-lock-warning-face (red foreground color)
in your buffer. Admittedly, it doesn't look prominent :-(

Move the cursor over the misplaced dot; there shall be a help message about.

> +    ;; Cleanup.
> +    (message "cleanup")
> +    (dbus-unregister-service :session dbus--test-service)))

I don't believe we need this message. We see that we're done :-)

> From 3efb1b38d75572b14ac0526dbd79769d6fa89d10 Mon Sep 17 00:00:00 2001
> From: Hugh Daschbach <hdasch@fastmail.com>
> Date: Mon, 21 Sep 2020 17:12:49 -0700
> Subject: [PATCH 2/2] Add D-Bus Introspection tests.
>
> * lisp/net/dbus.el (new defconst): D-Bus deprecation name.
>
> * test/lisp/net/dbus-tests.el  (dbus--tests-dir)
> (dbus--test-introspect) (dbus--test-examine-interface)
> (dbus--test-validate-annotations) (dbus--test-validate-property)
> (dbus--test-validate-m-or-s) (dbus--test-validate-signal)
> (dbus--test-validate-method) (dbus-test07-introspection): new tests.

That's not true. All but the last functions are new defuns, not new
tests. And please start the explanation with a capital letter, like "New test."

> +(defconst dbus-annotation-deprecated (concat dbus-interface-dbus ".Deprecated")
> +  "An annotation value indicating a deprecated interface, method, signal, or property.")

The docstring line does not fit 80 chars. What about

"An annotation indicating a deprecated interface, method, signal, or property."

> +(defvar dbus--tests-dir
> +  (file-truename
> +   (expand-file-name "dbus-tests"
> +                     (file-name-directory (or load-file-name
> +                                              buffer-file-name))))
> +  "Directory containing test data files.")

As said, it must be "dbus-resources".

> +(ert-deftest dbus-test07-introspection ()
> +  :tags '(:expensive-test)
> +  "Register an Introspection interface then query it."

:tags must be after the docstring.

> Cheers,
> Hugh

Best regards, Michael.

bug#43252: 27.1; DBus properties lack type hints or overrides

[Hugh Daschbach]

[-- Attachment #1: Type: text/plain, Size: 2255 bytes --]


Michael Albinus writes:

> Hugh Daschbach <hugh@ccss.com> writes:
>
> Hi Hugh,
>
> Oops, I'm mistaken here. The directory shall be called 
> dbus-resources,
> see .../test/file-organization.org. Sorry.

No worries.  Done.

> I'd vote for the latter, with the first argument :session 
> preceding
> the other arguments in the same line. Like
>
> (let* ((property
>         (dbus-introspect-get-property
> 	 :session dbus--test-service
> 	 dbus--test-path interface property-name)))
>    ...)

I think I've addressed this.  I reformatted a few tests that were
similarly indented.

> If you have one comment for several functions, use only one 
> parenthesis
> per line like
>
> (dbus--test-run-property-test, dbus--test-property)
> (dbus-test06-property-types): Test property registration, set, 
> get.

Done.  I think.


> `dbus-register-property' (if SELECTOR is `register') or

Done.  Apologies for not picking up the quoting issue the first 
time you
mentioned it.

> I bet the dot "." has the font-lock-warning-face (red foreground 
> color)
> in your buffer. Admittedly, it doesn't look prominent :-(
>
> Move the cursor over the misplaced dot; there shall be a help 
> message about.

Done.

> I don't believe we need this message. We see that we're done :-)

Gone.

>> * lisp/net/dbus.el (new defconst): D-Bus deprecation name.
>>
>> * test/lisp/net/dbus-tests.el  (dbus--tests-dir)
>> (dbus--test-introspect) (dbus--test-examine-interface)
>> (dbus--test-validate-annotations) 
>> (dbus--test-validate-property)
>> (dbus--test-validate-m-or-s) (dbus--test-validate-signal)
>> (dbus--test-validate-method) (dbus-test07-introspection): new 
>> tests.

I think I understand the ChangeLog format.  Additional corrections
welcome.

> The docstring line does not fit 80 chars. What about
>
> "An annotation indicating a deprecated interface, method, 
> signal, or property."

Done.

>> +(ert-deftest dbus-test07-introspection ()
>> +  :tags '(:expensive-test)
>> +  "Register an Introspection interface then query it."
>
> :tags must be after the docstring.

Corrected.

>> Cheers,
>> Hugh
>
> Best regards, Michael.

I think I've addressed all the issues you pointed out.  Let me 
know if
there's something that still doesn't look right.

Thanks
Hugh


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Property tests. --]
[-- Type: text/x-patch, Size: 15313 bytes --]

From 64dcf1a657a7610709072676905f0157178511eb Mon Sep 17 00:00:00 2001
From: Hugh Daschbach <hdasch@fastmail.com>
Date: Tue, 22 Sep 2020 19:36:20 -0700
Subject: [PATCH 1/2] Add D-Bus property tests.

* test/lisp/net/dbus-tests.el: Add property tests.
(dbus--test-run-property-test, dbus--test-property): New defuns.
(dbus-test06-property-types): New test for property registration, set, get.
---
 test/lisp/net/dbus-tests.el | 398 ++++++++++++++++++++++++++++++++++++
 1 file changed, 398 insertions(+)

diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el
index 2f20fcc1e67..2e0c061a556 100644
--- a/test/lisp/net/dbus-tests.el
+++ b/test/lisp/net/dbus-tests.el
@@ -1005,6 +1005,404 @@ 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 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
+         (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")
-- 
2.28.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: Introspection tests. --]
[-- Type: text/x-patch, Size: 15886 bytes --]

From 86f5834893efb1bc5fe907ce22d4b81260a2c553 Mon Sep 17 00:00:00 2001
From: Hugh Daschbach <hdasch@fastmail.com>
Date: Mon, 21 Sep 2020 17:12:49 -0700
Subject: [PATCH 2/2] Add D-Bus Introspection tests.

* lisp/net/dbus.el (dbus-annotation-deprecated): New defconst.

* test/lisp/net/dbus-tests.el  (dbus--tests-dir): New defvar.
(dbus--test-introspect, dbus--test-validate-interface)
(dbus--test-validate-annotations, dbus--test-validate-property)
(dbus--test-validate-m-or-s, dbus--test-validate-signal)
(dbus--test-validate-method): New defuns.
(dbus-test07-introspection): New test.

* test/lisp/net/dbus-tests/org.gnu.Emacs.TestDBus.xml: New test data.
---
 lisp/net/dbus.el                              |   3 +
 .../dbus-resources/org.gnu.Emacs.TestDBus.xml |  49 +++
 test/lisp/net/dbus-tests.el                   | 285 +++++++++++++++++-
 3 files changed, 336 insertions(+), 1 deletion(-)
 create mode 100644 test/lisp/net/dbus-resources/org.gnu.Emacs.TestDBus.xml

diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el
index 86db7cbf18a..7d45c859f12 100644
--- a/lisp/net/dbus.el
+++ b/lisp/net/dbus.el
@@ -153,6 +153,9 @@ dbus-interface-local
 ;;   </signal>
 ;; </interface>
 
+(defconst dbus-annotation-deprecated (concat dbus-interface-dbus ".Deprecated")
+  "An annotation indicating a deprecated interface, method, signal, or property.")
+
 \f
 ;;; Default D-Bus errors.
 
diff --git a/test/lisp/net/dbus-resources/org.gnu.Emacs.TestDBus.xml b/test/lisp/net/dbus-resources/org.gnu.Emacs.TestDBus.xml
new file mode 100644
index 00000000000..620f10510f2
--- /dev/null
+++ b/test/lisp/net/dbus-resources/org.gnu.Emacs.TestDBus.xml
@@ -0,0 +1,49 @@
+<?xml version="1.0"?>
+<!DOCTYPE node PUBLIC "-//freedesktop//DTD D-BUS Object Introspection 1.0//EN" "http://www.freedesktop.org/standards/dbus/1.0/introspect.dtd">
+<node>
+  <interface name="org.freedesktop.DBus.Introspectable">
+    <method name="Introspect">
+      <arg name="xml" type="s" direction="out"/>
+    </method>
+  </interface>
+  <interface name="org.freedesktop.DBus.Properties">
+    <method name="Get">
+      <arg name="interface" type="s" direction="in"/>
+      <arg name="name" type="s" direction="in"/>
+      <arg name="value" type="v" direction="out"/>
+    </method>
+    <method name="Set">
+      <arg name="interface" type="s" direction="in"/>
+      <arg name="name" type="s" direction="in"/>
+      <arg name="value" type="v" direction="in"/>
+    </method>
+    <method name="GetAll">
+      <arg name="interface" type="s" direction="in"/>
+      <arg name="properties" type="a{sv}" direction="out"/>
+    </method>
+    <signal name="PropertiesChanged">
+      <arg name="interface" type="s"/>
+      <arg name="changed_properties" type="a{sv}"/>
+      <arg name="invalidated_properties" type="as"/>
+    </signal>
+  </interface>
+  <interface name="org.gnu.Emacs.TestDBus.Interface">
+    <method name="Connect">
+      <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"/>
+    </method>
+    <method name="DeprecatedMethod0">
+      <annotation name="org.freedesktop.DBus.Deprecated" value="true"/>
+    </method>
+    <method name="DeprecatedMethod1">
+      <annotation name="org.freedesktop.DBus.Deprecated" value="true"/>
+    </method>
+    <property name="Connected" type="b" access="read"/>
+    <property name="Player" type="o" access="read"/>
+    <annotation name="org.freedesktop.DBus.Deprecated" value="true"/>
+  </interface>
+  <node name="node0"/>
+  <node name="node1"/>
+</node>
diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el
index 2e0c061a556..b764e8dc8db 100644
--- a/test/lisp/net/dbus-tests.el
+++ b/test/lisp/net/dbus-tests.el
@@ -44,6 +44,13 @@ dbus--test-path
 (defconst dbus--test-interface "org.gnu.Emacs.TestDBus.Interface"
   "Test interface.")
 
+(defvar dbus--tests-dir
+  (file-truename
+   (expand-file-name "dbus-resources"
+                     (file-name-directory (or load-file-name
+                                              buffer-file-name))))
+  "Directory containing introspection test data file.")
+
 (defun dbus--test-availability (bus)
   "Test availability of D-Bus BUS."
   (should (dbus-list-names bus))
@@ -1056,7 +1063,6 @@ dbus--test-run-property-test
 
 (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'.
@@ -1403,6 +1409,283 @@ dbus-test06-property-types
     ;; Cleanup.
     (dbus-unregister-service :session dbus--test-service)))
 
+(defun dbus--test-introspect ()
+  "Return test introspection string."
+  (with-temp-buffer
+    (insert-file (expand-file-name "org.gnu.Emacs.TestDBus.xml" dbus--tests-dir))
+    (buffer-string)))
+
+(defsubst dbus--test-validate-interface
+  (iface-name expected-properties expected-methods expected-signals
+              expected-annotations)
+  "Validate an interface definition for `dbus-test07-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, respectively."
+
+  (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))))))
+
+(defsubst dbus--test-validate-annotations (annotations expected-annotations)
+  "Validate a list of D-Bus 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-validate-property
+  (interface property-name expected-annotations &rest expected-args)
+  "Validate a property definition for `dbus-test07-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 is a list of strings matching
+the annotation names defined for the method or signal.
+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 expected)
+
+    (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-test07-introspection'.
+The argument TREE is an sexp returned from either `dbus-introspect-get-method'
+or `dbus-introspect-get-signal'
+The arguments EXPECTED-ANNOTATIONS is a list of strings matching
+the annotation names 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-validate-signal
+  (interface signal-name expected-annotations &rest expected-args)
+  "Validate a signal definition for `dbus-test07-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 is a list of strings matching
+the annotation names defined for the signal.
+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-validate-method
+  (interface method-name expected-annotations &rest expected-args)
+  "Validate a method definition for `dbus-test07-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 is a list of strings matching
+the annotation names defined for the method.
+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-introspection ()
+  "Register an Introspection interface then query it."
+  :tags '(:expensive-test)
+  (skip-unless dbus--test-enabled-session-bus)
+  (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service))
+  (dbus-register-service :session dbus--test-service)
+
+  ;; Prepare introspection response
+  (dbus-register-method
+   :session dbus--test-service dbus--test-path dbus-interface-introspectable
+   "Introspect" 'dbus--test-introspect)
+
+  (unwind-protect
+      (progn
+        ;; 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-validate-interface
+           dbus-interface-introspectable nil '("Introspect") nil nil)
+
+          ;; dbus-introspect-get-interface via `dbus--test-validate-interface'
+          (dbus--test-validate-interface
+           dbus-interface-properties nil
+           '("Get" "Set" "GetAll") '("PropertiesChanged") nil)
+
+          (dbus--test-validate-interface
+           dbus--test-interface '("Connected" "Player")
+           '("Connect" "DeprecatedMethod0" "DeprecatedMethod1") nil
+           `(,dbus-annotation-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-validate-method
+          (dbus--test-validate-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-validate-method
+           dbus--test-interface "DeprecatedMethod0"
+           `(,dbus-annotation-deprecated))
+
+          (dbus--test-validate-method
+           dbus--test-interface "DeprecatedMethod1"
+           `(,dbus-annotation-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-validate-signal
+          (dbus--test-validate-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-validate-property
+          (dbus--test-validate-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

bug#43252: 27.1; DBus properties lack type hints or overrides

[Michael Albinus]

Hugh Daschbach <hugh@ccss.com> writes:

Hi Hugh,

> I think I've addressed all the issues you pointed out.  Let me know if
> there's something that still doesn't look right.

I've roughly scanned the patches, they look almost OK. Let's wait now
for appearing your name on the copyright file.

Anyway, here's my nit of the day:

> * test/lisp/net/dbus-tests/org.gnu.Emacs.TestDBus.xml: New test data.

This shall be dbus-resources.

> Thanks
> Hugh

Best regards, Michael.

bug#43252: 27.1; DBus properties lack type hints or overrides

[Hugh Daschbach]

Michael Albinus writes:

> Hugh Daschbach <hugh@ccss.com> writes:
>
> Hi Hugh,
>
>> I think I've addressed all the issues you pointed out.  Let me know if
>> there's something that still doesn't look right.
>
> I've roughly scanned the patches, they look almost OK. Let's wait now
> for appearing your name on the copyright file.
>
> Anyway, here's my nit of the day:
>
>> * test/lisp/net/dbus-tests/org.gnu.Emacs.TestDBus.xml: New test data.
>
> This shall be dbus-resources.

Thanks.  Fixed.  Will wait for the paperwork to clear.  Then will rebase
and send you a final copy of the patches.

>> Thanks
>> Hugh
>
> Best regards, Michael.

I've taken a brief look at performance of the introspection tests.  The
long pole seems to be ERT, rather than the tests themselves.

Running the profiler while running ert showed The cpu profiler report
for running dbus-test07-introspection breaks down something like:

- GC      - 30%
- dbus-*  - 30%
- ert-*   - 40%

So I pulled introspection tests out into a separate file, redefined
`should', and reran dbus-test07-introspection.  It completed almost
instantly.  I wrapped the body of dbus-test07-introspection in a dotimes
form with 50 iterations.  That completes in roughly 1.1 seconds.

Comparing runtime and GC cycles for a single run,

running with ERT:  2 gcs in 2.228295 sec
running w/o ERT:   1 gcs in 0.036733 sec

Those numbers come from:

(let ((start (current-time))
      (gcs gcs-done))
  ;; test program call
  (message "%d gcs in %02f sec" (- gcs-done gcs) (float-time (time-since start))))

I'm not well versed in chasing Emacs performance issues, bit this looks
to me more like testing than introspection overhead.  Any
suggestions?


Cheers,
Hugh

bug#43252: 27.1; DBus properties lack type hints or overrides

[Hugh Daschbach]

Hugh Daschbach writes:

> I've taken a brief look at performance of the introspection tests.  The
> long pole seems to be ERT, rather than the tests themselves.
>
...
> I'm not well versed in chasing Emacs performance issues, bit this looks
> to me more like testing than introspection overhead.  Any
> suggestions?

Wrong again.  Digging further, I find that my performance tests were in
error.

Fixing that, elp helped me find that the performance hit came from
mishandling incoming introspection requests in ‘dbus--test-introspect’.

I hadn’t registered ‘dbus--test-introspect’ for the two subnodes exposed
in the xml file.  So introspecting those nodes timed out.  Each timeout
cost a second.

I’ve fixed this for the next patch set.  The change was simple enough.
I think that can wait until the paperwork clears, unless you want an
earlier look.

Cheers,
Hugh

bug#43252: 27.1; DBus properties lack type hints or overrides

[Michael Albinus]

Hugh Daschbach <hugh@ccss.com> writes:

Hi Hugh,

> Fixing that, elp helped me find that the performance hit came from
> mishandling incoming introspection requests in ‘dbus--test-introspect’.

Good to know. Introspection isn't to punish :-)

> I hadn’t registered ‘dbus--test-introspect’ for the two subnodes exposed
> in the xml file.  So introspecting those nodes timed out.  Each timeout
> cost a second.

OK. But maybe you add also one or two tests to check this error functionality.

> I’ve fixed this for the next patch set.  The change was simple enough.
> I think that can wait until the paperwork clears, unless you want an
> earlier look.

Sure, this can wait.

Btw, I have just pushed a larger patch to master. It implements a first
shot on the org.freedesktop.DBus.Monitoring.BecomeMonitor
functionality. If you want to see how it works, just call
(dbus-register-monitor :session) . There will be a new buffer *D-Bus
Monitor*, which shows you D-Bus messages similar to what the UNIX
command "dbus-monitor --session" does. The point is that you can
register your own handler to the monitor; if you don't declare an own
handler, the default handler `dbus-monitor-handler' is taken.

As said, it is just a first shot. Proper documentation is missing, and
not all arguments of `dbus-register-monitor' seem to work as
expected. But you might see which direction it will go; any feedback is
appreciated.

> Cheers,
> Hugh

Best regards, Michael.

bug#43252: 27.1; DBus properties lack type hints or overrides

[Hugh Daschbach]

Michael Albinus writes:

> Hugh Daschbach <hugh@ccss.com> writes:
>
>> in the xml file.  So introspecting those nodes timed out.  Each timeout
>> cost a second.
>
> OK. But maybe you add also one or two tests to check this error functionality.

Done.  dbus-test07-introspection now has a test that no timeout
occurred.  It is no longer tagged :expensive-test.

A new dbus-test07-timeout tests both implicit (dbus-introspect-*) and
explicit (dbus-call-method) timeouts.  It is tagged :expensive-test.

>> I’ve fixed this for the next patch set.  The change was simple enough.
> Btw, I have just pushed a larger patch to master. It implements a first
> shot on the org.freedesktop.DBus.Monitoring.BecomeMonitor
> functionality. If you want to see how it works, just call
> (dbus-register-monitor :session) . There will be a new buffer *D-Bus
> Monitor*, which shows you D-Bus messages similar to what the UNIX
> command "dbus-monitor --session" does. The point is that you can
> register your own handler to the monitor; if you don't declare an own
> handler, the default handler `dbus-monitor-handler' is taken.
>
> As said, it is just a first shot. Proper documentation is missing, and
> not all arguments of `dbus-register-monitor' seem to work as
> expected. But you might see which direction it will go; any feedback is
> appreciated.

Impressive.  This is a great source of proper signature syntax.  Not to
mention a most useful debugging tool.  Nice.

Timestamps (perhaps optional) would be useful, I think.

Cheers,
Hugh

bug#43252: 27.1; DBus properties lack type hints or overrides

[Michael Albinus]

Hugh Daschbach <hugh@ccss.com> writes:

Hi Hugh,

> A new dbus-test07-timeout tests both implicit (dbus-introspect-*) and
> explicit (dbus-call-method) timeouts.  It is tagged :expensive-test.

I like the idea of having test groups (identified by test<NN>). This
makes it more easy to select only tests I'm interested in.

Could you, pls, move the dbus-call-method timeout test into a test of
its own, dbus-test04-call-method-timeout? And the other test might be
called dbus-test07-introspect-timeout.

> Timestamps (perhaps optional) would be useful, I think.

Added. In case of method-return and error messages, I've added also the
time difference to the corresponding method-call.

And while I'm there, I've added also links between serial numbers. That
is, if you click on the serial number of a message-return or error
message, you jump to the corresponding methoid-call. And vice-versa.

> Cheers,
> Hugh

Best regards, Michael.

bug#43252: 27.1; DBus properties lack type hints or overrides

[Hugh Daschbach]

[-- Attachment #1: Type: text/plain, Size: 772 bytes --]


Michael Albinus writes:

> Hugh Daschbach <hugh@ccss.com> writes:
>
> Hi Hugh,
>
> Could you, pls, move the dbus-call-method timeout test into a test of
> its own, dbus-test04-call-method-timeout? And the other test might be
> called dbus-test07-introspect-timeout.

Sure.  I've attached a draft for your review.

>> Timestamps (perhaps optional) would be useful, I think.
>
> Added. In case of method-return and error messages, I've added also the
> time difference to the corresponding method-call.

Nice.

> And while I'm there, I've added also links between serial numbers. That
> is, if you click on the serial number of a message-return or error
> message, you jump to the corresponding methoid-call. And vice-versa.

That's awesome.  Great feature.

Cheers,
Hugh


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Timeout tests. --]
[-- Type: text/x-patch, Size: 2473 bytes --]

From 454a9f4505bde8068675dfdf58658f752f561729 Mon Sep 17 00:00:00 2001
From: Hugh Daschbach <hdasch@fastmail.com>
Date: Mon, 28 Sep 2020 12:44:34 -0700
Subject: [PATCH 3/4] Add D-Bus timeout tests.

* test/lisp/net/dbus-tests.el: Add timeout tests.
(dbus-test04-call-method-timeout, dbus-test07-introspection-timeout):
New tests.
---
 test/lisp/net/dbus-tests.el | 38 +++++++++++++++++++++++++++++++++++++
 1 file changed, 38 insertions(+)

diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el
index 28dcdd95c00..308f22eb6cc 100644
--- a/test/lisp/net/dbus-tests.el
+++ b/test/lisp/net/dbus-tests.el
@@ -581,6 +581,28 @@ dbus-test04-register-method
     ;; Cleanup.
     (dbus-unregister-service :session dbus--test-service)))
 
+(ert-deftest dbus-test04-call-method-timeout ()
+  "Verify `dbus-call-method' request timeout."
+  :tags '(:expensive-test)
+  (skip-unless dbus--test-enabled-session-bus)
+  (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service))
+  (dbus-register-service :session dbus--test-service)
+
+  (unwind-protect
+      (let ((start (current-time)))
+        ;; Test timeout override for method call.
+        (should-error
+         (dbus-call-method
+          :session dbus--test-service dbus--test-path
+          dbus-interface-introspectable "Introspect" :timeout 2500)
+         :type 'dbus-error)
+
+        (should
+         (< 2.4 (float-time (time-since start)) 2.7)))
+
+        (dbus-unregister-service :session dbus--test-service)))
+
+
 (defvar dbus--test-signal-received nil
   "Received signal value in `dbus--test-signal-handler'.")
 
@@ -1709,6 +1731,22 @@ dbus-test07-introspection
 
     (dbus-unregister-service :session dbus--test-service)))
 
+(ert-deftest dbus-test07-introspection-timeout ()
+  "Verify introspection request timeouts."
+  :tags '(:expensive-test)
+  (skip-unless dbus--test-enabled-session-bus)
+  (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service))
+  (dbus-register-service :session dbus--test-service)
+
+  (unwind-protect
+      (let ((start (current-time)))
+        (dbus-introspect-xml :session dbus--test-service dbus--test-path)
+        ;; Introspection internal timeout is one second.
+        (should
+         (< 1.0 (float-time (time-since start)))))
+
+        (dbus-unregister-service :session dbus--test-service)))
+
 (defun dbus-test-all (&optional interactive)
   "Run all tests for \\[dbus]."
   (interactive "p")
-- 
2.28.0

bug#43252: 27.1; DBus properties lack type hints or overrides

[Michael Albinus]

Hugh Daschbach <hugh@ccss.com> writes:

Hi Hugh,

>> Could you, pls, move the dbus-call-method timeout test into a test of
>> its own, dbus-test04-call-method-timeout? And the other test might be
>> called dbus-test07-introspect-timeout.
>
> Sure.  I've attached a draft for your review.

Thanks. LGTM.

> Cheers,
> Hugh

Best regards, Michael.

bug#43252: 27.1; DBus properties lack type hints or overrides

[Hugh Daschbach]

[-- Attachment #1: Type: text/plain, Size: 342 bytes --]


Michael Albinus writes:

> Hugh Daschbach <hugh@ccss.com> writes:
>
> Hi Hugh,
>
> Thanks. LGTM.

Thanks.  I received the FSF signed copyright document.  So we should be
clear for submission.

I've attached the four patches that we've been discussing: three for
bug#43252 and on for bug#43251.

Thanks for your patience and guidance.

Hugh


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Property tests. --]
[-- Type: text/x-patch, Size: 15325 bytes --]

From dab1113aa7ae964d888d0e3b00466d55292f035d Mon Sep 17 00:00:00 2001
From: Hugh Daschbach <hdasch@fastmail.com>
Date: Tue, 22 Sep 2020 19:36:20 -0700
Subject: [PATCH 1/4] Add D-Bus property tests.

* test/lisp/net/dbus-tests.el: Add property tests.
(dbus--test-run-property-test, dbus--test-property): New defuns.
(dbus-test06-property-types): New test for property registration, set, get.
---
 test/lisp/net/dbus-tests.el | 396 ++++++++++++++++++++++++++++++++++++
 1 file changed, 396 insertions(+)

diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el
index b853542a1f0..fcbb378b44f 100644
--- a/test/lisp/net/dbus-tests.el
+++ b/test/lisp/net/dbus-tests.el
@@ -1018,6 +1018,402 @@ 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 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")
-- 
2.28.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: Introspection tests. --]
[-- Type: text/x-patch, Size: 16061 bytes --]

From 1c250268d4e72ec5ff26f29e99ce138e9d22aaf3 Mon Sep 17 00:00:00 2001
From: Hugh Daschbach <hdasch@fastmail.com>
Date: Tue, 22 Sep 2020 19:36:20 -0700
Subject: [PATCH 2/4] Add D-Bus Introspection tests.

* lisp/net/dbus.el (dbus-annotation-deprecated): New defconst.

* test/lisp/net/dbus-tests.el  (dbus--tests-dir): New defvar.
(dbus--test-introspect, dbus--test-validate-interface)
(dbus--test-validate-annotations, dbus--test-validate-property)
(dbus--test-validate-m-or-s, dbus--test-validate-signal)
(dbus--test-validate-method): New defuns.
(dbus-test07-introspection): New test.

* test/lisp/net/dbus-resources/org.gnu.Emacs.TestDBus.xml: New test data.
---
 lisp/net/dbus.el                              |   3 +
 .../dbus-resources/org.gnu.Emacs.TestDBus.xml |  49 +++
 test/lisp/net/dbus-tests.el                   | 295 ++++++++++++++++++
 3 files changed, 347 insertions(+)
 create mode 100644 test/lisp/net/dbus-resources/org.gnu.Emacs.TestDBus.xml

diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el
index fec9d3c7ab8..09ccc001bdb 100644
--- a/lisp/net/dbus.el
+++ b/lisp/net/dbus.el
@@ -165,6 +165,9 @@ dbus-interface-local
 ;;   </signal>
 ;; </interface>
 
+(defconst dbus-annotation-deprecated (concat dbus-interface-dbus ".Deprecated")
+  "An annotation indicating a deprecated interface, method, signal, or property.")
+
 \f
 ;;; Default D-Bus errors.
 
diff --git a/test/lisp/net/dbus-resources/org.gnu.Emacs.TestDBus.xml b/test/lisp/net/dbus-resources/org.gnu.Emacs.TestDBus.xml
new file mode 100644
index 00000000000..620f10510f2
--- /dev/null
+++ b/test/lisp/net/dbus-resources/org.gnu.Emacs.TestDBus.xml
@@ -0,0 +1,49 @@
+<?xml version="1.0"?>
+<!DOCTYPE node PUBLIC "-//freedesktop//DTD D-BUS Object Introspection 1.0//EN" "http://www.freedesktop.org/standards/dbus/1.0/introspect.dtd">
+<node>
+  <interface name="org.freedesktop.DBus.Introspectable">
+    <method name="Introspect">
+      <arg name="xml" type="s" direction="out"/>
+    </method>
+  </interface>
+  <interface name="org.freedesktop.DBus.Properties">
+    <method name="Get">
+      <arg name="interface" type="s" direction="in"/>
+      <arg name="name" type="s" direction="in"/>
+      <arg name="value" type="v" direction="out"/>
+    </method>
+    <method name="Set">
+      <arg name="interface" type="s" direction="in"/>
+      <arg name="name" type="s" direction="in"/>
+      <arg name="value" type="v" direction="in"/>
+    </method>
+    <method name="GetAll">
+      <arg name="interface" type="s" direction="in"/>
+      <arg name="properties" type="a{sv}" direction="out"/>
+    </method>
+    <signal name="PropertiesChanged">
+      <arg name="interface" type="s"/>
+      <arg name="changed_properties" type="a{sv}"/>
+      <arg name="invalidated_properties" type="as"/>
+    </signal>
+  </interface>
+  <interface name="org.gnu.Emacs.TestDBus.Interface">
+    <method name="Connect">
+      <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"/>
+    </method>
+    <method name="DeprecatedMethod0">
+      <annotation name="org.freedesktop.DBus.Deprecated" value="true"/>
+    </method>
+    <method name="DeprecatedMethod1">
+      <annotation name="org.freedesktop.DBus.Deprecated" value="true"/>
+    </method>
+    <property name="Connected" type="b" access="read"/>
+    <property name="Player" type="o" access="read"/>
+    <annotation name="org.freedesktop.DBus.Deprecated" value="true"/>
+  </interface>
+  <node name="node0"/>
+  <node name="node1"/>
+</node>
diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el
index fcbb378b44f..28dcdd95c00 100644
--- a/test/lisp/net/dbus-tests.el
+++ b/test/lisp/net/dbus-tests.el
@@ -46,6 +46,13 @@ dbus--test-path
 (defconst dbus--test-interface "org.gnu.Emacs.TestDBus.Interface"
   "Test interface.")
 
+(defvar dbus--tests-dir
+  (file-truename
+   (expand-file-name "dbus-resources"
+                     (file-name-directory (or load-file-name
+                                              buffer-file-name))))
+  "Directory containing introspection test data file.")
+
 (defun dbus--test-availability (bus)
   "Test availability of D-Bus BUS."
   (should (dbus-list-names bus))
@@ -1414,6 +1421,294 @@ dbus-test06-property-types
     ;; Cleanup.
     (dbus-unregister-service :session dbus--test-service)))
 
+(defun dbus--test-introspect ()
+  "Return test introspection string."
+  (when (string-equal dbus--test-path (dbus-event-path-name last-input-event))
+    (with-temp-buffer
+      (insert-file (expand-file-name "org.gnu.Emacs.TestDBus.xml" dbus--tests-dir))
+      (buffer-string))))
+
+(defsubst dbus--test-validate-interface
+  (iface-name expected-properties expected-methods expected-signals
+              expected-annotations)
+  "Validate an interface definition for `dbus-test07-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, respectively."
+
+  (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))))))
+
+(defsubst dbus--test-validate-annotations (annotations expected-annotations)
+  "Validate a list of D-Bus 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-validate-property
+  (interface property-name expected-annotations &rest expected-args)
+  "Validate a property definition for `dbus-test07-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 is a list of strings matching
+the annotation names defined for the method or signal.
+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 expected)
+
+    (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-test07-introspection'.
+The argument TREE is an sexp returned from either `dbus-introspect-get-method'
+or `dbus-introspect-get-signal'
+The arguments EXPECTED-ANNOTATIONS is a list of strings matching
+the annotation names 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-validate-signal
+  (interface signal-name expected-annotations &rest expected-args)
+  "Validate a signal definition for `dbus-test07-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 is a list of strings matching
+the annotation names defined for the signal.
+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-validate-method
+  (interface method-name expected-annotations &rest expected-args)
+  "Validate a method definition for `dbus-test07-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 is a list of strings matching
+the annotation names defined for the method.
+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-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 introspection response.
+  (dbus-register-method
+   :session dbus--test-service dbus--test-path dbus-interface-introspectable
+   "Introspect" 'dbus--test-introspect)
+  (dbus-register-method
+   :session dbus--test-service (concat dbus--test-path "/node0")
+   dbus-interface-introspectable
+   "Introspect" 'dbus--test-introspect)
+  (dbus-register-method
+   :session dbus--test-service (concat dbus--test-path "/node1")
+   dbus-interface-introspectable
+   "Introspect" 'dbus--test-introspect)
+  (unwind-protect
+      (let ((start (current-time)))
+        ;; 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-validate-interface
+           dbus-interface-introspectable nil '("Introspect") nil nil)
+
+          ;; dbus-introspect-get-interface via `dbus--test-validate-interface'
+          (dbus--test-validate-interface
+           dbus-interface-properties nil
+           '("Get" "Set" "GetAll") '("PropertiesChanged") nil)
+
+          (dbus--test-validate-interface
+           dbus--test-interface '("Connected" "Player")
+           '("Connect" "DeprecatedMethod0" "DeprecatedMethod1") nil
+           `(,dbus-annotation-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-validate-method
+          (dbus--test-validate-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-validate-method
+           dbus--test-interface "DeprecatedMethod0"
+           `(,dbus-annotation-deprecated))
+
+          (dbus--test-validate-method
+           dbus--test-interface "DeprecatedMethod1"
+           `(,dbus-annotation-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-validate-signal
+          (dbus--test-validate-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-validate-property
+          (dbus--test-validate-property
+           dbus--test-interface "Connected" nil
+           '("Connected" "b" "read")
+           '("Player" "o" "read")))
+
+        ;; Elapsed time over a second suggests timeouts.
+        (should
+         (< 0.0 (float-time (time-since start)) 1.0)))
+
+    (dbus-unregister-service :session dbus--test-service)))
+
 (defun dbus-test-all (&optional interactive)
   "Run all tests for \\[dbus]."
   (interactive "p")
-- 
2.28.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: Timeout Tests. --]
[-- Type: text/x-patch, Size: 2473 bytes --]

From 454a9f4505bde8068675dfdf58658f752f561729 Mon Sep 17 00:00:00 2001
From: Hugh Daschbach <hdasch@fastmail.com>
Date: Mon, 28 Sep 2020 12:44:34 -0700
Subject: [PATCH 3/4] Add D-Bus timeout tests.

* test/lisp/net/dbus-tests.el: Add timeout tests.
(dbus-test04-call-method-timeout, dbus-test07-introspection-timeout):
New tests.
---
 test/lisp/net/dbus-tests.el | 38 +++++++++++++++++++++++++++++++++++++
 1 file changed, 38 insertions(+)

diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el
index 28dcdd95c00..308f22eb6cc 100644
--- a/test/lisp/net/dbus-tests.el
+++ b/test/lisp/net/dbus-tests.el
@@ -581,6 +581,28 @@ dbus-test04-register-method
     ;; Cleanup.
     (dbus-unregister-service :session dbus--test-service)))
 
+(ert-deftest dbus-test04-call-method-timeout ()
+  "Verify `dbus-call-method' request timeout."
+  :tags '(:expensive-test)
+  (skip-unless dbus--test-enabled-session-bus)
+  (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service))
+  (dbus-register-service :session dbus--test-service)
+
+  (unwind-protect
+      (let ((start (current-time)))
+        ;; Test timeout override for method call.
+        (should-error
+         (dbus-call-method
+          :session dbus--test-service dbus--test-path
+          dbus-interface-introspectable "Introspect" :timeout 2500)
+         :type 'dbus-error)
+
+        (should
+         (< 2.4 (float-time (time-since start)) 2.7)))
+
+        (dbus-unregister-service :session dbus--test-service)))
+
+
 (defvar dbus--test-signal-received nil
   "Received signal value in `dbus--test-signal-handler'.")
 
@@ -1709,6 +1731,22 @@ dbus-test07-introspection
 
     (dbus-unregister-service :session dbus--test-service)))
 
+(ert-deftest dbus-test07-introspection-timeout ()
+  "Verify introspection request timeouts."
+  :tags '(:expensive-test)
+  (skip-unless dbus--test-enabled-session-bus)
+  (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service))
+  (dbus-register-service :session dbus--test-service)
+
+  (unwind-protect
+      (let ((start (current-time)))
+        (dbus-introspect-xml :session dbus--test-service dbus--test-path)
+        ;; Introspection internal timeout is one second.
+        (should
+         (< 1.0 (float-time (time-since start)))))
+
+        (dbus-unregister-service :session dbus--test-service)))
+
 (defun dbus-test-all (&optional interactive)
   "Run all tests for \\[dbus]."
   (interactive "p")
-- 
2.28.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: Call method reentry test. --]
[-- Type: text/x-patch, Size: 2127 bytes --]

From 3dc9e44e2f10530ef2b20cc9f8c3851606905d5e Mon Sep 17 00:00:00 2001
From: Hugh Daschbach <hdasch@fastmail.com>
Date: Mon, 28 Sep 2020 14:34:54 -0700
Subject: [PATCH 4/4] Add D-Bus method call reentry test.

* test/lisp/net/dbus-tests.el (dbus--tests-method-reentry-handler): New defun.
(dbus-test04-method-reentry): New test.
---
 test/lisp/net/dbus-tests.el | 34 ++++++++++++++++++++++++++++++++++
 1 file changed, 34 insertions(+)

diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el
index 308f22eb6cc..339eaa7405d 100644
--- a/test/lisp/net/dbus-tests.el
+++ b/test/lisp/net/dbus-tests.el
@@ -581,6 +581,40 @@ dbus-test04-register-method
     ;; Cleanup.
     (dbus-unregister-service :session dbus--test-service)))
 
+(defun dbus--test-method-reentry-handler (&rest args)
+  "Method handler for `dbus-test04-method-reentry'."
+  (dbus-get-all-managed-objects :session dbus--test-service dbus--test-path)
+  42)
+
+(ert-deftest dbus-test04-method-reentry ()
+  "Check receiving method call while awaiting response.
+Ensure that incoming method calls are handled when call to `dbus-call-method'
+is in progress."
+  ;; Simulate application registration (Bug#43251)
+  (skip-unless dbus--test-enabled-session-bus)
+  (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service))
+
+  (unwind-protect
+      (let ((method "Rentry"))
+        (should
+         (equal
+          (dbus-register-method
+           :session dbus--test-service dbus--test-path
+           dbus--test-interface method #'dbus--test-method-reentry-handler)
+          `((:method :session ,dbus--test-interface ,method)
+            (,dbus--test-service ,dbus--test-path
+             dbus--test-method-reentry-handler))))
+
+        (should
+         (=
+          (dbus-call-method
+           :session dbus--test-service dbus--test-path
+           dbus--test-interface method)
+          42)))
+
+    ;; Cleanup.
+    (dbus-unregister-service :session dbus--test-service)))
+
 (ert-deftest dbus-test04-call-method-timeout ()
   "Verify `dbus-call-method' request timeout."
   :tags '(:expensive-test)
-- 
2.28.0

bug#43252: 27.1; DBus properties lack type hints or overrides

[Michael Albinus]

Hugh Daschbach <hugh@ccss.com> writes:

Hi Hugh,

> Thanks.  I received the FSF signed copyright document.  So we should be
> clear for submission.

Yep. You're also on file now.

> I've attached the four patches that we've been discussing: three for
> bug#43252 and on for bug#43251.

Thanks a lot! I've pushed them to master.

If you have further submissions, just tell me. I will submit them in
your name then.

If you plan for regular submissions to Emacs, you might ask the Emacs
maintainers (Eli Zaretskii, Lars Ingebrigtsen or John Wiegley) for write
access on the git repo.

> Thanks for your patience and guidance.
>
> Hugh

Best regards, Michael.

bug#43252: 27.1; DBus properties lack type hints or overrides

[Michael Albinus]

Michael Albinus <michael.albinus@gmx.de> writes:

Hi Hugh,

>> I've attached the four patches that we've been discussing: three for
>> bug#43252 and on for bug#43251.
>
> Thanks a lot! I've pushed them to master.

PS: I've pushed also a minor code cleanup, mainly triggered by compiler warnings.

Best regards, Michael.

bug#43252: 27.1; DBus properties lack type hints or overrides

[Hugh Daschbach]

Michael Albinus writes:

> Michael Albinus <michael.albinus@gmx.de> writes:
>
> Hi Hugh,
>
>>
>> Thanks a lot! I've pushed them to master.
>
> PS: I've pushed also a minor code cleanup, mainly triggered by compiler warnings.

Thank you.  I've reviewed your changes.  I appreciate the stylistic
changes.  And will add a compile step to my list workflow.

Thanks again.
Hugh