Add Message dispatchers
authorReto Buerki <reet@codelabs.ch>
Mon, 19 Oct 2020 16:14:30 +0000 (18:14 +0200)
committerReto Buerki <reet@codelabs.ch>
Fri, 23 Oct 2020 05:35:33 +0000 (07:35 +0200)
The packages in the Message_Dispatcher hierarchy can be used to
implement a non-blocking D-Bus service which reacts to methods and
signals, without the need for the Glib main event loop. Furthermore, the
new framework is more flexible than the existing Connection.Dispatch
procedure.

Clients choose between a procedure- or object-oriented dispatcher variant,
depending on the application requirements.

The Glib-based dispatching, D_Bus.Service and Connection.Dispatch might
be removed in the future.

src/d_bus-message_dispatcher-object.adb [new file with mode: 0644]
src/d_bus-message_dispatcher-object.ads [new file with mode: 0644]
src/d_bus-message_dispatcher-proc.adb [new file with mode: 0644]
src/d_bus-message_dispatcher-proc.ads [new file with mode: 0644]
src/d_bus-message_dispatcher.adb [new file with mode: 0644]
src/d_bus-message_dispatcher.ads [new file with mode: 0644]
tests/message_dispatcher_tests.adb [new file with mode: 0644]
tests/message_dispatcher_tests.ads [new file with mode: 0644]
tests/runner.adb

diff --git a/src/d_bus-message_dispatcher-object.adb b/src/d_bus-message_dispatcher-object.adb
new file mode 100644 (file)
index 0000000..a0fb116
--- /dev/null
@@ -0,0 +1,101 @@
+--
+--  D_Bus/Ada - An Ada binding to D-Bus
+--
+--  Copyright (C) 2019  Tobias Brunner <tbrunner@hsr.ch>
+--  Copyright (C) 2020  Reto Buerki <reet@codelabs.ch>
+--
+--  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 2
+--  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, write to the Free Software
+--  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301,
+--  USA.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit,  or  you  link  this  unit  with  other  files  to  produce  an
+--  executable   this  unit  does  not  by  itself  cause  the  resulting
+--  executable to  be  covered by the  GNU General  Public License.  This
+--  exception does  not  however  invalidate  any  other reasons why  the
+--  executable file might be covered by the GNU Public License.
+--
+
+package body D_Bus.Message_Dispatcher.Object
+is
+
+   use Ada.Strings.Unbounded;
+
+   -------------------------------------------------------------------------
+
+   function Create (Introspect : String) return OO_Dispatcher_Type
+   is
+   begin
+      return OO_Dispatcher_Type'
+        (Introspect => To_Unbounded_String (Introspect),
+         others     => <>);
+   end Create;
+
+   -------------------------------------------------------------------------
+
+   procedure Handle_Message
+     (Dispatcher :     OO_Dispatcher_Type;
+      In_Msg     :     D_Bus.Messages.Message_Type;
+      Signal     :     Boolean;
+      Success    : out Boolean)
+   is
+      List : constant List_Of_Handlers_Pkg.List
+        := (if Signal then Dispatcher.Signal_Handlers else
+               Dispatcher.Method_Handlers);
+      Check : constant Msg_Dst_Check_Func
+        := (if Signal then Messages.Is_Signal'Access else
+               Messages.Is_Method_Call'Access);
+   begin
+      Success := False;
+
+      for H of List loop
+         if Check (In_Msg, To_String (H.Iface), To_String (H.Method))
+         then
+            Success := True;
+            H.Handler.Dispatch (In_Msg => In_Msg);
+         end if;
+      end loop;
+   end Handle_Message;
+
+   -------------------------------------------------------------------------
+
+   procedure Register_Method_Handler
+     (Dispatcher : in out OO_Dispatcher_Type;
+      Iface      :        String;
+      Method     :        String;
+      Handler    :        Handler_Access)
+   is
+   begin
+      Dispatcher.Method_Handlers.Append
+        (New_Item => (Iface   => To_Unbounded_String (Iface),
+                      Method  => To_Unbounded_String (Method),
+                      Handler => Handler));
+   end Register_Method_Handler;
+
+   -------------------------------------------------------------------------
+
+   procedure Register_Signal_Handler
+     (Dispatcher  : in out OO_Dispatcher_Type;
+      Iface       :        String;
+      Signal_Name :        String;
+      Handler     :        Handler_Access)
+   is
+   begin
+      Dispatcher.Signal_Handlers.Append
+        (New_Item => (Iface   => To_Unbounded_String (Iface),
+                      Method  => To_Unbounded_String (Signal_Name),
+                      Handler => Handler));
+   end Register_Signal_Handler;
+
+end D_Bus.Message_Dispatcher.Object;
diff --git a/src/d_bus-message_dispatcher-object.ads b/src/d_bus-message_dispatcher-object.ads
new file mode 100644 (file)
index 0000000..5fbd1e1
--- /dev/null
@@ -0,0 +1,96 @@
+--
+--  D_Bus/Ada - An Ada binding to D-Bus
+--
+--  Copyright (C) 2019  Tobias Brunner <tbrunner@hsr.ch>
+--  Copyright (C) 2020  Reto Buerki <reet@codelabs.ch>
+--
+--  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 2
+--  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, write to the Free Software
+--  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301,
+--  USA.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit,  or  you  link  this  unit  with  other  files  to  produce  an
+--  executable   this  unit  does  not  by  itself  cause  the  resulting
+--  executable to  be  covered by the  GNU General  Public License.  This
+--  exception does  not  however  invalidate  any  other reasons why  the
+--  executable file might be covered by the GNU Public License.
+--
+
+with Ada.Containers.Doubly_Linked_Lists;
+
+with D_Bus.Messages;
+
+package D_Bus.Message_Dispatcher.Object
+is
+
+   type Handler_Type is interface;
+
+   type Handler_Access is access all Handler_Type'Class;
+
+   --  Dispatch procedure to handle incoming messages. The In_Msg must not be
+   --  unref'd, this is done by the Peek procedure. Use the Messages.Ref
+   --  function to store an In_Msg for further use.
+   procedure Dispatch
+     (H      : in out Handler_Type;
+      In_Msg :        D_Bus.Messages.Message_Type)
+   is abstract;
+
+   type OO_Dispatcher_Type is new Dispatcher_Type with private;
+
+   --  Create new object-oriented message dispatcher.
+   --  The introspection data is handed out to clients if the 'Introspect'
+   --  method is called on the 'org.freedesktop.DBus.Introspectable' interface.
+   function Create (Introspect : String) return OO_Dispatcher_Type;
+
+   --  Register dispatcher procedure for given Interface/Method call. Multiple
+   --  registrations for the same Interface/Method are possible.
+   procedure Register_Method_Handler
+     (Dispatcher : in out OO_Dispatcher_Type;
+      Iface      :        String;
+      Method     :        String;
+      Handler    :        Handler_Access);
+
+   --  Register dispatcher procedure for given Interface/Signal. Multiple
+   --  registrations for the same Interface/Signal are possible.
+   procedure Register_Signal_Handler
+     (Dispatcher  : in out OO_Dispatcher_Type;
+      Iface       :        String;
+      Signal_Name :        String;
+      Handler     :        Handler_Access);
+
+   --  Handle method call or signal designated by Msg.In_Msg. Returns True if a
+   --  handler is registered for the requested method call or signal, False if
+   --  not.
+   overriding
+   procedure Handle_Message
+     (Dispatcher :     OO_Dispatcher_Type;
+      In_Msg     :     D_Bus.Messages.Message_Type;
+      Signal     :     Boolean;
+      Success    : out Boolean);
+
+private
+
+   type Registration_Type is new Base_Registration_Type with record
+      Handler : Handler_Access;
+   end record;
+
+   package List_Of_Handlers_Pkg is new Ada.Containers.Doubly_Linked_Lists
+     (Element_Type => Registration_Type);
+
+   type OO_Dispatcher_Type is new Dispatcher_Type with record
+      Method_Handlers : List_Of_Handlers_Pkg.List;
+      Signal_Handlers : List_Of_Handlers_Pkg.List;
+   end record;
+
+end D_Bus.Message_Dispatcher.Object;
diff --git a/src/d_bus-message_dispatcher-proc.adb b/src/d_bus-message_dispatcher-proc.adb
new file mode 100644 (file)
index 0000000..23b7fc9
--- /dev/null
@@ -0,0 +1,101 @@
+--
+--  D_Bus/Ada - An Ada binding to D-Bus
+--
+--  Copyright (C) 2019  Tobias Brunner <tbrunner@hsr.ch>
+--  Copyright (C) 2020  Reto Buerki <reet@codelabs.ch>
+--
+--  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 2
+--  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, write to the Free Software
+--  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301,
+--  USA.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit,  or  you  link  this  unit  with  other  files  to  produce  an
+--  executable   this  unit  does  not  by  itself  cause  the  resulting
+--  executable to  be  covered by the  GNU General  Public License.  This
+--  exception does  not  however  invalidate  any  other reasons why  the
+--  executable file might be covered by the GNU Public License.
+--
+
+package body D_Bus.Message_Dispatcher.Proc
+is
+
+   use Ada.Strings.Unbounded;
+
+   -------------------------------------------------------------------------
+
+   function Create (Introspect : String) return Proc_Dispatcher_Type
+   is
+   begin
+      return Proc_Dispatcher_Type'
+        (Introspect => To_Unbounded_String (Introspect),
+         others     => <>);
+   end Create;
+
+   -------------------------------------------------------------------------
+
+   procedure Handle_Message
+     (Dispatcher :     Proc_Dispatcher_Type;
+      In_Msg     :     D_Bus.Messages.Message_Type;
+      Signal     :     Boolean;
+      Success    : out Boolean)
+   is
+      List : constant List_Of_Handlers_Pkg.List
+        := (if Signal then Dispatcher.Signal_Handlers else
+               Dispatcher.Method_Handlers);
+      Check : constant Msg_Dst_Check_Func
+        := (if Signal then Messages.Is_Signal'Access else
+               Messages.Is_Method_Call'Access);
+   begin
+      Success := False;
+
+      for H of List loop
+         if Check (In_Msg, To_String (H.Iface), To_String (H.Method))
+         then
+            Success := True;
+            H.Handler (In_Msg => In_Msg);
+         end if;
+      end loop;
+   end Handle_Message;
+
+   -------------------------------------------------------------------------
+
+   procedure Register_Method_Handler
+     (Dispatcher : in out Proc_Dispatcher_Type;
+      Iface      :        String;
+      Method     :        String;
+      Handler    :        Dispatch_Procedure)
+   is
+   begin
+      Dispatcher.Method_Handlers.Append
+        (New_Item => (Iface   => To_Unbounded_String (Iface),
+                      Method  => To_Unbounded_String (Method),
+                      Handler => Handler));
+   end Register_Method_Handler;
+
+   -------------------------------------------------------------------------
+
+   procedure Register_Signal_Handler
+     (Dispatcher  : in out Proc_Dispatcher_Type;
+      Iface       :        String;
+      Signal_Name :        String;
+      Handler     :        Dispatch_Procedure)
+   is
+   begin
+      Dispatcher.Signal_Handlers.Append
+        (New_Item => (Iface   => To_Unbounded_String (Iface),
+                      Method  => To_Unbounded_String (Signal_Name),
+                      Handler => Handler));
+   end Register_Signal_Handler;
+
+end D_Bus.Message_Dispatcher.Proc;
diff --git a/src/d_bus-message_dispatcher-proc.ads b/src/d_bus-message_dispatcher-proc.ads
new file mode 100644 (file)
index 0000000..2809cb3
--- /dev/null
@@ -0,0 +1,91 @@
+--
+--  D_Bus/Ada - An Ada binding to D-Bus
+--
+--  Copyright (C) 2019  Tobias Brunner <tbrunner@hsr.ch>
+--  Copyright (C) 2020  Reto Buerki <reet@codelabs.ch>
+--
+--  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 2
+--  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, write to the Free Software
+--  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301,
+--  USA.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit,  or  you  link  this  unit  with  other  files  to  produce  an
+--  executable   this  unit  does  not  by  itself  cause  the  resulting
+--  executable to  be  covered by the  GNU General  Public License.  This
+--  exception does  not  however  invalidate  any  other reasons why  the
+--  executable file might be covered by the GNU Public License.
+--
+
+with Ada.Containers.Doubly_Linked_Lists;
+
+with D_Bus.Messages;
+
+--  Procedure-based dispatcher.
+package D_Bus.Message_Dispatcher.Proc
+is
+
+   --  Dispatch procedure to handle incoming messages. The In_Msg must not be
+   --  unref'd, this is done by the Peek procedure. Use the Messages.Ref
+   --  function to store an In_Msg for further use.
+   type Dispatch_Procedure is access procedure
+     (In_Msg : D_Bus.Messages.Message_Type);
+
+   type Proc_Dispatcher_Type is new Dispatcher_Type with private;
+
+   --  Create new procedure-based message dispatcher.
+   --  The introspection data is handed out to clients if the 'Introspect'
+   --  method is called on the 'org.freedesktop.DBus.Introspectable' interface.
+   function Create (Introspect : String) return Proc_Dispatcher_Type;
+
+   --  Register dispatcher procedure for given Interface/Method call. Multiple
+   --  registrations for the same Interface/Method are possible.
+   procedure Register_Method_Handler
+     (Dispatcher : in out Proc_Dispatcher_Type;
+      Iface      :        String;
+      Method     :        String;
+      Handler    :        Dispatch_Procedure);
+
+   --  Register dispatcher procedure for given Interface/Signal. Multiple
+   --  registrations for the same Interface/Signal are possible.
+   procedure Register_Signal_Handler
+     (Dispatcher  : in out Proc_Dispatcher_Type;
+      Iface       :        String;
+      Signal_Name :        String;
+      Handler     :        Dispatch_Procedure);
+
+   --  Handle method call or signal designated by In_Msg. Returns True if a
+   --  handler is registered for the requested method call or signal, False if
+   --  not.
+   overriding
+   procedure Handle_Message
+     (Dispatcher :     Proc_Dispatcher_Type;
+      In_Msg     :     D_Bus.Messages.Message_Type;
+      Signal     :     Boolean;
+      Success    : out Boolean);
+
+private
+
+   type Registration_Type is new Base_Registration_Type with record
+      Handler : Dispatch_Procedure;
+   end record;
+
+   package List_Of_Handlers_Pkg is new Ada.Containers.Doubly_Linked_Lists
+     (Element_Type => Registration_Type);
+
+   type Proc_Dispatcher_Type is new Dispatcher_Type with record
+      Method_Handlers : List_Of_Handlers_Pkg.List;
+      Signal_Handlers : List_Of_Handlers_Pkg.List;
+   end record;
+
+end D_Bus.Message_Dispatcher.Proc;
diff --git a/src/d_bus-message_dispatcher.adb b/src/d_bus-message_dispatcher.adb
new file mode 100644 (file)
index 0000000..bf26436
--- /dev/null
@@ -0,0 +1,104 @@
+--
+--  D_Bus/Ada - An Ada binding to D-Bus
+--
+--  Copyright (C) 2019  Tobias Brunner <tbrunner@hsr.ch>
+--  Copyright (C) 2020  Reto Buerki <reet@codelabs.ch>
+--
+--  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 2
+--  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, write to the Free Software
+--  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301,
+--  USA.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit,  or  you  link  this  unit  with  other  files  to  produce  an
+--  executable   this  unit  does  not  by  itself  cause  the  resulting
+--  executable to  be  covered by the  GNU General  Public License.  This
+--  exception does  not  however  invalidate  any  other reasons why  the
+--  executable file might be covered by the GNU Public License.
+--
+
+with D_Bus.Arguments.Basic;
+with D_Bus.Messagebox;
+
+package body D_Bus.Message_Dispatcher
+is
+
+   use Ada.Strings.Unbounded;
+
+   -------------------------------------------------------------------------
+
+   procedure Peek
+     (Dispatcher   :     Dispatcher_Type'Class;
+      Conn         :     Connection.Connection_Type;
+      Timeout_Msec :     Integer := 100;
+      Success      : out Boolean)
+   is
+      use D_Bus.Arguments.Basic;
+      use type D_Bus.Messages.Message_Variant;
+
+      Handled         : Boolean;
+      In_Msg, Out_Msg : Messages.Message_Type;
+   begin
+      Success := Connection.Read_Write
+        (Connection   => Conn,
+         Timeout_Msec => Timeout_Msec);
+
+      Connection.Pop_Message (Connection => Conn,
+                              Message    => In_Msg);
+
+      if not Messages.Is_Null (Msg => In_Msg) then
+         if Messages.Is_Method_Call
+           (Msg    => In_Msg,
+            Iface  => "org.freedesktop.DBus.Introspectable",
+            Method => "Introspect")
+         then
+            Out_Msg := Messages.New_Method_Return
+              (Method_Call => In_Msg);
+            Messages.Add_Arguments
+              (Msg  => Out_Msg,
+               Args => +To_String (Dispatcher.Introspect));
+            D_Bus.Messagebox.Enqueue (M => Out_Msg);
+            return;
+         end if;
+
+         case Messages.Get_Type (Msg => In_Msg)
+         is
+            when Messages.Method_Call =>
+               Dispatcher.Handle_Message
+                 (In_Msg  => In_Msg,
+                  Signal  => False,
+                  Success => Handled);
+            when Messages.Signal =>
+               Dispatcher.Handle_Message
+                 (In_Msg  => In_Msg,
+                  Signal  => True,
+                  Success => Handled);
+            when others => null;
+         end case;
+
+         if not Handled then
+            if Messages.Get_Type (Msg => In_Msg) = Messages.Method_Call
+            then
+               Out_Msg := Messages.New_Error
+                 (Reply_To      => In_Msg,
+                  Error_Name    => "org.freedesktop.resolve1.UnknownMethod",
+                  Error_Message => "Unknown method call");
+               D_Bus.Messagebox.Enqueue (M => Out_Msg);
+            end if;
+         end if;
+
+         D_Bus.Messages.Unref (Msg => In_Msg);
+      end if;
+   end Peek;
+
+end D_Bus.Message_Dispatcher;
diff --git a/src/d_bus-message_dispatcher.ads b/src/d_bus-message_dispatcher.ads
new file mode 100644 (file)
index 0000000..f160bee
--- /dev/null
@@ -0,0 +1,83 @@
+--
+--  D_Bus/Ada - An Ada binding to D-Bus
+--
+--  Copyright (C) 2019  Tobias Brunner <tbrunner@hsr.ch>
+--  Copyright (C) 2020  Reto Buerki <reet@codelabs.ch>
+--
+--  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 2
+--  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, write to the Free Software
+--  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301,
+--  USA.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit,  or  you  link  this  unit  with  other  files  to  produce  an
+--  executable   this  unit  does  not  by  itself  cause  the  resulting
+--  executable to  be  covered by the  GNU General  Public License.  This
+--  exception does  not  however  invalidate  any  other reasons why  the
+--  executable file might be covered by the GNU Public License.
+--
+
+private with Ada.Strings.Unbounded;
+
+with D_Bus.Connection;
+with D_Bus.Messages;
+
+package D_Bus.Message_Dispatcher
+is
+
+   type Dispatcher_Type is abstract tagged limited private;
+
+   --  Create new message dispatcher.
+   --  The introspection data is handed out to clients if the 'Introspect'
+   --  method is called on the 'org.freedesktop.DBus.Introspectable' interface.
+   function Create (Introspect : String) return Dispatcher_Type is abstract;
+
+   --  Handle method call or signal designated by In_Msg. Returns True if a
+   --  handler is registered for the requested method call or signal, False if
+   --  not.
+   procedure Handle_Message
+     (Dispatcher :     Dispatcher_Type;
+      In_Msg     :     D_Bus.Messages.Message_Type;
+      Signal     :     Boolean;
+      Success    : out Boolean) is abstract;
+
+   --  Peek for a new message to dispatch. Use a timeout of -1 to wait an
+   --  infinite amount of time for a new message to appear.
+   --  Success is False if the internal bus connection received the disconnect
+   --  messsage. If no handler is registered for a given
+   --  interface/method/signal or the Introspect method is called, an
+   --  appropriate (error) message is enqued in the Messagebox package for
+   --  further processing.
+   procedure Peek
+     (Dispatcher   :     Dispatcher_Type'Class;
+      Conn         :     Connection.Connection_Type;
+      Timeout_Msec :     Integer := 100;
+      Success      : out Boolean);
+
+private
+
+   type Dispatcher_Type is abstract tagged limited record
+      Introspect : Ada.Strings.Unbounded.Unbounded_String;
+   end record;
+
+   type Base_Registration_Type is tagged record
+      Iface  : Ada.Strings.Unbounded.Unbounded_String;
+      Method : Ada.Strings.Unbounded.Unbounded_String;
+   end record;
+
+   type Msg_Dst_Check_Func is  access function
+     (Msg    : Messages.Message_Type;
+      Iface  : String;
+      Method : String) return Boolean;
+
+end D_Bus.Message_Dispatcher;
diff --git a/tests/message_dispatcher_tests.adb b/tests/message_dispatcher_tests.adb
new file mode 100644 (file)
index 0000000..582fe24
--- /dev/null
@@ -0,0 +1,175 @@
+--
+--  D_Bus/Ada - An Ada binding to D-Bus
+--
+--  Copyright (C) 2020  Reto Buerki <reet@codelabs.ch>
+--
+--  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 2
+--  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, write to the Free Software
+--  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301,
+--  USA.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit,  or  you  link  this  unit  with  other  files  to  produce  an
+--  executable   this  unit  does  not  by  itself  cause  the  resulting
+--  executable to  be  covered by the  GNU General  Public License.  This
+--  exception does  not  however  invalidate  any  other reasons why  the
+--  executable file might be covered by the GNU Public License.
+--
+
+with Ahven;
+
+with D_Bus.Messages;
+with D_Bus.Connection;
+with D_Bus.Arguments.Basic;
+with D_Bus.Message_Dispatcher.Proc;
+with D_Bus.Message_Dispatcher.Object;
+with D_Bus.Types;
+
+package body Message_Dispatcher_Tests is
+
+   use Ahven;
+   use D_Bus;
+
+   -------------------------------------------------------------------------
+
+   procedure Initialize (T : in out Testcase) is
+   begin
+      T.Set_Name (Name => "Message dispatchers");
+      T.Add_Test_Routine
+        (Routine => Proc_Dispatcher'Access,
+         Name    => "Procedure-based dispatching");
+      T.Add_Test_Routine
+        (Routine => OO_Dispatcher'Access,
+         Name    => "Object-based dispatching");
+   end Initialize;
+
+   -------------------------------------------------------------------------
+
+   procedure OO_Dispatcher
+   is
+      type Object_Type is new
+        D_Bus.Message_Dispatcher.Object.Handler_Type
+      with record
+         Called : Boolean := False;
+      end record;
+
+      ----------------------------------------------------------------------
+
+      overriding
+      procedure Dispatch
+        (O     : in out Object_Type;
+         In_Mg :        D_Bus.Messages.Message_Type);
+
+      procedure Dispatch
+        (O     : in out Object_Type;
+         In_Mg :        D_Bus.Messages.Message_Type)
+      is
+         pragma Unreferenced (In_Mg);
+      begin
+         O.Called := True;
+      end Dispatch;
+
+      use D_Bus.Arguments;
+      use D_Bus.Arguments.Basic;
+      use type D_Bus.Types.Obj_Path;
+
+      Object  : aliased Object_Type;
+      Success : Boolean;
+      D       : Message_Dispatcher.Object.OO_Dispatcher_Type;
+      Dummy   : Argument_List_Type;
+      Conn    : constant Connection.Connection_Type
+        := Connection.Connect (Bus => Bus_Session);
+   begin
+      Connection.Add_Match
+        (Connection => Conn,
+         Rule       => "type='signal'");
+      D.Register_Signal_Handler
+        (Iface       => "dbus.ada.msg_dispatcher",
+         Signal_Name => "event",
+         Handler     => Object'Unchecked_Access);
+
+      Connection.Send_Signal
+        (Connection  => Conn,
+         Object_Name => +"/",
+         Iface       => "dbus.ada.msg_dispatcher",
+         Name        => "event",
+         Args        => +True);
+
+      for I in 1 .. 10 loop
+         D.Peek (Conn    => Conn,
+                 Success => Success);
+         exit when not Success or Object.Called;
+         delay 0.1;
+      end loop;
+
+      Assert (Condition => Success,
+              Message   => "Not success");
+      Assert (Condition => Object.Called,
+              Message   => "Object not called");
+   end OO_Dispatcher;
+
+   -------------------------------------------------------------------------
+
+   procedure Proc_Dispatcher
+   is
+      Handled : Boolean := False;
+
+      ----------------------------------------------------------------------
+
+      procedure Handle (In_Msg : D_Bus.Messages.Message_Type);
+      procedure Handle (In_Msg : D_Bus.Messages.Message_Type)
+      is
+         pragma Unreferenced (In_Msg);
+      begin
+         Handled := True;
+      end Handle;
+
+      use D_Bus.Arguments;
+      use D_Bus.Arguments.Basic;
+      use type D_Bus.Types.Obj_Path;
+
+      Success : Boolean;
+      D       : Message_Dispatcher.Proc.Proc_Dispatcher_Type;
+      Dummy   : Argument_List_Type;
+      Conn    : constant Connection.Connection_Type
+        := Connection.Connect (Bus => Bus_Session);
+   begin
+      Connection.Add_Match
+        (Connection => Conn,
+         Rule       => "type='signal'");
+      D.Register_Signal_Handler
+        (Iface       => "dbus.ada.msg_dispatcher",
+         Signal_Name => "event",
+         Handler     => Handle'Unrestricted_Access);
+
+      Connection.Send_Signal
+        (Connection  => Conn,
+         Object_Name => +"/",
+         Iface       => "dbus.ada.msg_dispatcher",
+         Name        => "event",
+         Args        => +True);
+
+      for I in 1 .. 10 loop
+         D.Peek (Conn    => Conn,
+                 Success => Success);
+         exit when not Success or Handled;
+         delay 0.1;
+      end loop;
+
+      Assert (Condition => Success,
+              Message   => "Not success");
+      Assert (Condition => Handled,
+              Message   => "Not handled");
+   end Proc_Dispatcher;
+
+end Message_Dispatcher_Tests;
diff --git a/tests/message_dispatcher_tests.ads b/tests/message_dispatcher_tests.ads
new file mode 100644 (file)
index 0000000..19787dd
--- /dev/null
@@ -0,0 +1,44 @@
+--
+--  D_Bus/Ada - An Ada binding to D-Bus
+--
+--  Copyright (C) 2020  Reto Buerki <reet@codelabs.ch>
+--
+--  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 2
+--  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, write to the Free Software
+--  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301,
+--  USA.
+--
+--  As a special exception, if other files instantiate generics from this
+--  unit,  or  you  link  this  unit  with  other  files  to  produce  an
+--  executable   this  unit  does  not  by  itself  cause  the  resulting
+--  executable to  be  covered by the  GNU General  Public License.  This
+--  exception does  not  however  invalidate  any  other reasons why  the
+--  executable file might be covered by the GNU Public License.
+--
+
+with Ahven.Framework;
+
+package Message_Dispatcher_Tests is
+
+   type Testcase is new Ahven.Framework.Test_Case with null record;
+
+   procedure Initialize (T : in out Testcase);
+   --  Initialize testcase.
+
+   procedure Proc_Dispatcher;
+   --  Test procedure-based dispatcher.
+
+   procedure OO_Dispatcher;
+   --  Test object-based dispatcher.
+
+end Message_Dispatcher_Tests;
index 2f16b5ffee0cd80a5de38dc3cacb7604892517a5..fb011b0142542ca953a77528819ef0bdf6d8d3d4 100644 (file)
@@ -37,6 +37,7 @@ with Arguments_Container_Tests;
 with Service_Tests;
 with Types_Tests;
 with Messagebox_Tests;
+with Message_Dispatcher_Tests;
 
 procedure Runner is
    S : constant Ahven.Framework.Test_Suite_Access :=
@@ -62,6 +63,9 @@ begin
    Ahven.Framework.Add_Test
      (Suite => S.all,
       T     => new Messagebox_Tests.Testcase);
+   Ahven.Framework.Add_Test
+     (Suite => S.all,
+      T     => new Message_Dispatcher_Tests.Testcase);
 
    Ahven.Text_Runner.Run (Suite => S);
    Ahven.Framework.Release_Suite (T => S);