-----------------------------------------------------------------------
--  wiki-strings -- Wiki string types and operations
--  Copyright (C) 2016, 2017, 2020, 2022 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Containers;
with Ada.Strings.Wide_Wide_Unbounded;
with Ada.Strings.Wide_Wide_Maps;
with Ada.Strings.Wide_Wide_Hash;
with Ada.Characters.Conversions;
with Ada.Wide_Wide_Characters.Handling;
with Ada.Strings.Wide_Wide_Fixed;
with Ada.Strings.UTF_Encoding.Wide_Wide_Strings;
with Util.Texts.Builders;

package Wiki.Strings is

   pragma Preelaborate;

   subtype WChar is Wide_Wide_Character;
   subtype WString is Wide_Wide_String;
   subtype UString is Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String;
   subtype WChar_Mapping is Ada.Strings.Wide_Wide_Maps.Wide_Wide_Character_Mapping;

   function To_WChar (C : in Character) return WChar
                      renames Ada.Characters.Conversions.To_Wide_Wide_Character;

   function To_Char (C : in WChar; Substitute : in Character := ' ') return Character
                     renames Ada.Characters.Conversions.To_Character;

   function To_String (S : in WString; Output_BOM : in Boolean := False) return String
                       renames Ada.Strings.UTF_Encoding.Wide_Wide_Strings.Encode;

   function To_UString (S : in WString) return UString
                        renames Ada.Strings.Wide_Wide_Unbounded.To_Unbounded_Wide_Wide_String;

   function To_WString (S : in UString) return WString
                        renames Ada.Strings.Wide_Wide_Unbounded.To_Wide_Wide_String;

   function To_WString (S : in String) return WString
                        renames Ada.Strings.UTF_Encoding.Wide_Wide_Strings.Decode;

   function Hash (S : in WString) return Ada.Containers.Hash_Type
     renames Ada.Strings.Wide_Wide_Hash;

   procedure Append (Into : in out UString; S : in WString)
                     renames Ada.Strings.Wide_Wide_Unbounded.Append;

   procedure Append (Into : in out UString; S : in WChar)
                     renames Ada.Strings.Wide_Wide_Unbounded.Append;

   function Length (S : in UString) return Natural
                    renames Ada.Strings.Wide_Wide_Unbounded.Length;

   function Element (S : in UString; Pos : in Positive) return WChar
                     renames Ada.Strings.Wide_Wide_Unbounded.Element;

   function Is_Alphanumeric (C : in WChar) return Boolean
     renames Ada.Wide_Wide_Characters.Handling.Is_Alphanumeric;

   function Index (S       : in WString;
                   P       : in WString;
                   Going   : in Ada.Strings.Direction := Ada.Strings.Forward;
                   Mapping : in WChar_Mapping := Ada.Strings.Wide_Wide_Maps.Identity)
     return Natural renames Ada.Strings.Wide_Wide_Fixed.Index;

   Null_UString : UString
   renames Ada.Strings.Wide_Wide_Unbounded.Null_Unbounded_Wide_Wide_String;

   package Wide_Wide_Builders is new Util.Texts.Builders (Element_Type => WChar,
                                                          Input        => WString,
                                                          Chunk_Size   => 512);

   subtype BString is Wide_Wide_Builders.Builder;

   function Length (Source : in Bstring) return Natural renames Wide_Wide_Builders.Length;

   function Element (Source   : in BString;
                     Position : in Positive) return WChar renames Wide_Wide_Builders.Element;

   procedure Append_String (Source   : in out BString;
                            Content  : in WString) renames Wide_Wide_Builders.Append;

   procedure Append (Source   : in out BString;
                     Content  : in BString;
                     From     : in Positive;
                     To       : in Positive) renames Wide_Wide_Builders.Append;

   --  Search for the first occurrence of the character in the builder and
   --  starting after the from index.  Returns the index of the first occurence or 0.
   function Index (Source : in BString;
                   Char   : in WChar;
                   From   : in Positive := 1) return Natural;

   --  Find the last position of the character in the string and starting
   --  at the given position.  Stop at the first character different than `Char`.
   function Last_Position (Source : in Bstring;
                           Char   : in WChar;
                           From   : in Positive := 1) return Natural;

   --  Count the the number of consecutive occurence of the given character
   --  and starting at the given position.
   function Count_Occurence (Source : in Bstring;
                             Char   : in Wchar;
                             From   : in Positive := 1) return Natural;

   function Skip_Spaces (Source : in Bstring;
                         From   : in Positive;
                         Last   : in Positive) return Positive;

end Wiki.Strings;

-----------------------------------------------------------------------
--  wiki-strings -- Wiki string types and operations
--  Copyright (C) 2016, 2017, 2020, 2022 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Containers;
with Ada.Strings.Wide_Wide_Unbounded;
with Ada.Strings.Wide_Wide_Maps;
with Ada.Strings.Wide_Wide_Hash;
with Ada.Characters.Conversions;
with Ada.Wide_Wide_Characters.Handling;
with Ada.Strings.Wide_Wide_Fixed;
with Ada.Strings.UTF_Encoding.Wide_Wide_Strings;
with Util.Texts.Builders;

package Wiki.Strings is

   pragma Preelaborate;

   subtype WChar is Wide_Wide_Character;
   subtype WString is Wide_Wide_String;
   subtype UString is Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String;
   subtype WChar_Mapping is Ada.Strings.Wide_Wide_Maps.Wide_Wide_Character_Mapping;

   function To_WChar (C : in Character) return WChar
                      renames Ada.Characters.Conversions.To_Wide_Wide_Character;

   function To_Char (C : in WChar; Substitute : in Character := ' ') return Character
                     renames Ada.Characters.Conversions.To_Character;

   function To_String (S : in WString; Output_BOM : in Boolean := False) return String
                       renames Ada.Strings.UTF_Encoding.Wide_Wide_Strings.Encode;

   function To_UString (S : in WString) return UString
                        renames Ada.Strings.Wide_Wide_Unbounded.To_Unbounded_Wide_Wide_String;

   function To_WString (S : in UString) return WString
                        renames Ada.Strings.Wide_Wide_Unbounded.To_Wide_Wide_String;

   function To_WString (S : in String) return WString
                        renames Ada.Strings.UTF_Encoding.Wide_Wide_Strings.Decode;

   function Hash (S : in WString) return Ada.Containers.Hash_Type
     renames Ada.Strings.Wide_Wide_Hash;

   procedure Append (Into : in out UString; S : in WString)
                     renames Ada.Strings.Wide_Wide_Unbounded.Append;

   procedure Append (Into : in out UString; S : in WChar)
                     renames Ada.Strings.Wide_Wide_Unbounded.Append;

   function Length (S : in UString) return Natural
                    renames Ada.Strings.Wide_Wide_Unbounded.Length;

   function Element (S : in UString; Pos : in Positive) return WChar
                     renames Ada.Strings.Wide_Wide_Unbounded.Element;

   function Is_Alphanumeric (C : in WChar) return Boolean
     renames Ada.Wide_Wide_Characters.Handling.Is_Alphanumeric;

   function Index (S       : in WString;
                   P       : in WString;
                   Going   : in Ada.Strings.Direction := Ada.Strings.Forward;
                   Mapping : in WChar_Mapping := Ada.Strings.Wide_Wide_Maps.Identity)
     return Natural renames Ada.Strings.Wide_Wide_Fixed.Index;

   Null_UString : UString
   renames Ada.Strings.Wide_Wide_Unbounded.Null_Unbounded_Wide_Wide_String;

   package Wide_Wide_Builders is new Util.Texts.Builders (Element_Type => WChar,
                                                          Input        => WString,
                                                          Chunk_Size   => 512);

   subtype BString is Wide_Wide_Builders.Builder;

   function Length (Source : in BString) return Natural renames Wide_Wide_Builders.Length;

   function Element (Source   : in BString;
                     Position : in Positive) return WChar renames Wide_Wide_Builders.Element;

   function To_WString (Source : in BString) return WString renames Wide_Wide_Builders.To_Array;

   procedure Clear (Source   : in out BString) renames Wide_Wide_Builders.Clear;

   procedure Append_String (Source   : in out BString;
                            Content  : in WString) renames Wide_Wide_Builders.Append;

   procedure Append (Source   : in out BString;
                     Content  : in BString;
                     From     : in Positive;
                     To       : in Positive) renames Wide_Wide_Builders.Append;

   procedure Append_Char (Source   : in out BString;
                          Item     : in WChar) renames Wide_Wide_Builders.Append;

   --  Search for the first occurrence of the character in the builder and
   --  starting after the from index.  Returns the index of the first occurence or 0.
   function Index (Source : in BString;
                   Char   : in WChar;
                   From   : in Positive := 1) return Natural;

   --  Find the last position of the character in the string and starting
   --  at the given position.  Stop at the first character different than `Char`.
   function Last_Position (Source : in BString;
                           Char   : in WChar;
                           From   : in Positive := 1) return Natural;

   --  Count the the number of consecutive occurence of the given character
   --  and starting at the given position.
   function Count_Occurence (Source : in BString;
                             Char   : in WChar;
                             From   : in Positive := 1) return Natural;
   function Count_Occurence (Source : in WString;
                             Char   : in WChar;
                             From   : in Positive := 1) return Natural;

   function Skip_Spaces (Source : in BString;
                         From   : in Positive;
                         Last   : in Positive) return Positive;

   procedure Scan_Line_Fragment (Source  : in BString;
                                 Process : not null
                                    access procedure (Text   : in WString;
                                                      Offset : in Natural));

end Wiki.Strings;

Add new operations for strings

Add new operations for strings


-----------------------------------------------------------------------
--  wiki-helpers -- Helper operations for wiki parsers and renderer
--  Copyright (C) 2016 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Wide_Wide_Characters.Handling;

package body Wiki.Helpers is

   --  ------------------------------
   --  Returns True if the character is a space or tab.
   --  ------------------------------
   function Is_Space (C : in Wide_Wide_Character) return Boolean is
   begin
      return Ada.Wide_Wide_Characters.Handling.Is_Space (C) or C = HT;
   end Is_Space;

   --  ------------------------------
   --  Returns True if the character is a space, tab or a newline.
   --  ------------------------------
   function Is_Space_Or_Newline (C : in Wide_Wide_Character) return Boolean is
   begin
      return Is_Space (C) or Ada.Wide_Wide_Characters.Handling.Is_Line_Terminator (C);
   end Is_Space_Or_Newline;

   --  ------------------------------
   --  Returns True if the text is a valid URL
   --  ------------------------------
   function Is_Url (Text : in Wide_Wide_String) return Boolean is
   begin
      if Text'Length <= 9 then
         return False;
      else
         return Text (Text'First .. Text'First + 6) = "http://"
           or Text (Text'First .. Text'First + 7) = "https://";
      end if;
   end Is_Url;

   --  ------------------------------
   --  Returns True if the extension part correspond to an image.
   --  Recognized extension are: .png, .gif, .jpg, .jpeg.
   --  The extension case is ignored.
   --  ------------------------------
   function Is_Image_Extension (Ext : in Wide_Wide_String) return Boolean is
      S : constant Wide_Wide_String := Ada.Wide_Wide_Characters.Handling.To_Lower (Ext);
   begin
      return S = ".png" or S = ".jpg" or S = ".gif" or S = ".jpeg";
   end Is_Image_Extension;

end Wiki.Helpers;

-----------------------------------------------------------------------
--  wiki-helpers -- Helper operations for wiki parsers and renderer
--  Copyright (C) 2016 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Wide_Wide_Characters.Handling;

package body Wiki.Helpers is

   --  ------------------------------
   --  Returns True if the character is a space or tab.
   --  ------------------------------
   function Is_Space (C : in Wide_Wide_Character) return Boolean is
   begin
      return Ada.Wide_Wide_Characters.Handling.Is_Space (C) or C = HT;
   end Is_Space;

   --  ------------------------------
   --  Returns True if the character is a space, tab or a newline.
   --  ------------------------------
   function Is_Space_Or_Newline (C : in Wide_Wide_Character) return Boolean is
   begin
      return Is_Space (C) or Ada.Wide_Wide_Characters.Handling.Is_Line_Terminator (C);
   end Is_Space_Or_Newline;

   --  ------------------------------
   --  Returns True if the text is a valid URL
   --  ------------------------------
   function Is_Url (Text : in Wide_Wide_String) return Boolean is
   begin
      if Text'Length <= 9 then
         return False;
      else
         return Text (Text'First .. Text'First + 6) = "http://"
           or Text (Text'First .. Text'First + 7) = "https://";
      end if;
   end Is_Url;

   --  ------------------------------
   --  Returns True if the extension part correspond to an image.
   --  Recognized extension are: .png, .gif, .jpg, .jpeg.
   --  The extension case is ignored.
   --  ------------------------------
   function Is_Image_Extension (Ext : in Wide_Wide_String) return Boolean is
      S : constant Wide_Wide_String := Ada.Wide_Wide_Characters.Handling.To_Lower (Ext);
   begin
      return S = ".png" or S = ".jpg" or S = ".gif" or S = ".jpeg";
   end Is_Image_Extension;

   --  ------------------------------
   --  Given the current tag on the top of the stack and the new tag that will be pushed,
   --  decide whether the current tag must be closed or not.
   --  Returns True if the current tag must be closed.
   --  ------------------------------
   function Need_Close (Tag         : in Html_Tag;
                        Current_Tag : in Html_Tag) return Boolean is
   begin
      if No_End_Tag (Current_Tag) then
         return True;
      elsif Current_Tag = Tag and Tag_Omission (Current_Tag) then
         return True;
      else
         case Current_Tag is
            when DT_TAG | DD_TAG =>
               return Tag = DD_TAG or Tag = DL_TAG or Tag = DT_TAG;

            when TD_TAG =>
               return Tag = TD_TAG or Tag = TR_TAG or Tag = TH_TAG;

            when TR_TAG =>
               return False;

            when others =>
               return False;

         end case;
      end if;
   end Need_Close;

end Wiki.Helpers;

Move the Need_Close internal function to the Wiki.Helpers package


-----------------------------------------------------------------------
--  events-tests -- Unit tests for AWA events
--  Copyright (C) 2012 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Util.Tests;
with Util.Test_Caller;

with EL.Beans;
with EL.Expressions;
with EL.Contexts.Default;

with ASF.Applications;
with AWA.Applications;
with AWA.Applications.Configs;
with AWA.Applications.Factory;
with AWA.Tests;
with ADO.Sessions;

with AWA.Events.Queues;
with AWA.Events.Queues.Fifos;
with AWA.Events.Services;

package body AWA.Events.Tests is

   use AWA.Events.Services;

   package Event_Test_4 is new AWA.Events.Definition (Name => "event-test-4");
   package Event_Test_1 is new AWA.Events.Definition (Name => "event-test-1");
   package Event_Test_3 is new AWA.Events.Definition (Name => "event-test-3");
   package Event_Test_2 is new AWA.Events.Definition (Name => "event-test-2");
   package Event_Test_5 is new AWA.Events.Definition (Name => "event-test-5");

   package Caller is new Util.Test_Caller (Test, "Events.Tests");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Events.Find_Event_Index",
                       Test_Find_Event'Access);
      Caller.Add_Test (Suite, "Test AWA.Events.Initialize",
                       Test_Initialize'Access);
      Caller.Add_Test (Suite, "Test AWA.Events.Add_Action",
                       Test_Add_Action'Access);
      Caller.Add_Test (Suite, "Test AWA.Events.Dispatch",
                       Test_Dispatch'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test searching an event name in the definition list.
   --  ------------------------------
   procedure Test_Find_Event (T : in out Test) is
   begin
      Util.Tests.Assert_Equals (T, Integer (Event_Test_4.Kind),
                                Integer (Find_Event_Index ("event-test-4")), "Find_Event");
      Util.Tests.Assert_Equals (T, Integer (Event_Test_5.Kind),
                                Integer (Find_Event_Index ("event-test-5")), "Find_Event");
      Util.Tests.Assert_Equals (T, Integer (Event_Test_1.Kind),
                                Integer (Find_Event_Index ("event-test-1")), "Find_Event");
   end Test_Find_Event;

   --  ------------------------------
   --  Test creation and initialization of event manager.
   --  ------------------------------
   procedure Test_Initialize (T : in out Test) is
      App     : AWA.Applications.Application_Access := AWA.Tests.Get_Application;
      Manager : Event_Manager;
      Session : ADO.Sessions.Master_Session := App.Get_Master_Session;
   begin
      Manager.Initialize (Session);
--        T.Assert (Manager.Actions /= null, "Initialization failed");
   end Test_Initialize;

   --  ------------------------------
   --  Test adding an action.
   --  ------------------------------
   procedure Test_Add_Action (T : in out Test) is
      use AWA.Events.Queues;

      App     : AWA.Applications.Application_Access := AWA.Tests.Get_Application;
      Manager : Event_Manager;
      Ctx     : EL.Contexts.Default.Default_Context;
      Session : ADO.Sessions.Master_Session := App.Get_Master_Session;
      Action  : EL.Expressions.Method_Expression := EL.Expressions.Create_Expression ("#{a.send}", Ctx);
      Props   : EL.Beans.Param_Vectors.Vector;
      Pos     : Event_Index := Find_Event_Index ("event-test-4");
      Queue   : Queue_Access;
   begin
      Manager.Initialize (Session);

      Queue := AWA.Events.Queues.Fifos.Create_Queue ("fifo", Props, Ctx);
      Manager.Add_Queue (Queue);
      for I in 1 .. 10 loop
         Manager.Add_Action (Event  => "event-test-4",
                             Queue  => Queue,
                             Action => Action,
                             Params => Props);
--           Util.Tests.Assert_Equals (T, 1, Integer (Manager.Actions (Pos).Queues.Length),
--                                     "Add_Action failed");
      end loop;

   end Test_Add_Action;

   --  Test dispatching events
   procedure Test_Dispatch (T : in out Test) is

      Factory  : AWA.Applications.Factory.Application_Factory;
      Conf  : ASF.Applications.Config;
      App   : aliased AWA.Applications.Application;
      Ctx   : aliased EL.Contexts.Default.Default_Context;
      Path  : constant String := Util.Tests.Get_Test_Path ("regtests/config/event-test.xml");
   begin
      Conf.Set ("database", Util.Tests.Get_Parameter ("database"));
      App.Initialize (Conf    => Conf,
                      Factory => Factory);
      AWA.Applications.Configs.Read_Configuration (App     => App,
                                                   File    => Path,
                                                   Context => Ctx'Unchecked_Access);

      for I in 1 .. 100 loop
         declare
            Event : Module_Event;
         begin
            Event.Set_Event_Kind (Event_Test_4.Kind);
            Event.Set_Parameter ("prio", "3");
            Event.Set_Parameter ("template", "def");
            App.Send_Event (Event);
         end;
      end loop;
   end Test_Dispatch;

end AWA.Events.Tests;

-----------------------------------------------------------------------
--  events-tests -- Unit tests for AWA events
--  Copyright (C) 2012 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Util.Tests;
with Util.Test_Caller;

with EL.Beans;
with EL.Expressions;
with EL.Contexts.Default;

with ASF.Applications;
with AWA.Applications;
with AWA.Applications.Configs;
with AWA.Applications.Factory;
with AWA.Tests;
with ADO.Sessions;

with AWA.Events.Queues;
with AWA.Events.Services;

package body AWA.Events.Tests is

   use AWA.Events.Services;

   package Event_Test_4 is new AWA.Events.Definition (Name => "event-test-4");
   package Event_Test_1 is new AWA.Events.Definition (Name => "event-test-1");
   package Event_Test_3 is new AWA.Events.Definition (Name => "event-test-3");
   package Event_Test_2 is new AWA.Events.Definition (Name => "event-test-2");
   package Event_Test_5 is new AWA.Events.Definition (Name => "event-test-5");

   package Caller is new Util.Test_Caller (Test, "Events.Tests");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Events.Find_Event_Index",
                       Test_Find_Event'Access);
      Caller.Add_Test (Suite, "Test AWA.Events.Initialize",
                       Test_Initialize'Access);
      Caller.Add_Test (Suite, "Test AWA.Events.Add_Action",
                       Test_Add_Action'Access);
      Caller.Add_Test (Suite, "Test AWA.Events.Dispatch",
                       Test_Dispatch'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test searching an event name in the definition list.
   --  ------------------------------
   procedure Test_Find_Event (T : in out Test) is
   begin
      Util.Tests.Assert_Equals (T, Integer (Event_Test_4.Kind),
                                Integer (Find_Event_Index ("event-test-4")), "Find_Event");
      Util.Tests.Assert_Equals (T, Integer (Event_Test_5.Kind),
                                Integer (Find_Event_Index ("event-test-5")), "Find_Event");
      Util.Tests.Assert_Equals (T, Integer (Event_Test_1.Kind),
                                Integer (Find_Event_Index ("event-test-1")), "Find_Event");
   end Test_Find_Event;

   --  ------------------------------
   --  Test creation and initialization of event manager.
   --  ------------------------------
   procedure Test_Initialize (T : in out Test) is
      App     : AWA.Applications.Application_Access := AWA.Tests.Get_Application;
      Manager : Event_Manager;
      Session : ADO.Sessions.Master_Session := App.Get_Master_Session;
   begin
      Manager.Initialize (Session);
--        T.Assert (Manager.Actions /= null, "Initialization failed");
   end Test_Initialize;

   --  ------------------------------
   --  Test adding an action.
   --  ------------------------------
   procedure Test_Add_Action (T : in out Test) is
      use AWA.Events.Queues;

      App     : AWA.Applications.Application_Access := AWA.Tests.Get_Application;
      Manager : Event_Manager;
      Ctx     : EL.Contexts.Default.Default_Context;
      Session : ADO.Sessions.Master_Session := App.Get_Master_Session;
      Action  : EL.Expressions.Method_Expression := EL.Expressions.Create_Expression ("#{a.send}", Ctx);
      Props   : EL.Beans.Param_Vectors.Vector;
      Pos     : Event_Index := Find_Event_Index ("event-test-4");
      Queue   : Queue_Ref;
   begin
      Manager.Initialize (Session);

      Queue := AWA.Events.Queues.Create_Queue ("test", "fifo", Props, Ctx);
      Manager.Add_Queue (Queue);
      for I in 1 .. 10 loop
         Manager.Add_Action (Event  => "event-test-4",
                             Queue  => Queue,
                             Action => Action,
                             Params => Props);
--           Util.Tests.Assert_Equals (T, 1, Integer (Manager.Actions (Pos).Queues.Length),
--                                     "Add_Action failed");
      end loop;

   end Test_Add_Action;

   --  Test dispatching events
   procedure Test_Dispatch (T : in out Test) is

      Factory  : AWA.Applications.Factory.Application_Factory;
      Conf  : ASF.Applications.Config;
      App   : aliased AWA.Applications.Application;
      Ctx   : aliased EL.Contexts.Default.Default_Context;
      Path  : constant String := Util.Tests.Get_Test_Path ("regtests/config/event-test.xml");
   begin
      Conf.Set ("database", Util.Tests.Get_Parameter ("database"));
      App.Initialize (Conf    => Conf,
                      Factory => Factory);
      AWA.Applications.Configs.Read_Configuration (App     => App,
                                                   File    => Path,
                                                   Context => Ctx'Unchecked_Access);

      for I in 1 .. 100 loop
         declare
            Event : Module_Event;
         begin
            Event.Set_Event_Kind (Event_Test_4.Kind);
            Event.Set_Parameter ("prio", "3");
            Event.Set_Parameter ("template", "def");
            App.Send_Event (Event);
         end;
      end loop;
   end Test_Dispatch;

end AWA.Events.Tests;

Update the AWA event unit test

Update the AWA event unit test


-----------------------------------------------------------------------
--  util-commands-tests - Test for commands
--  Copyright (C) 2018, 2019, 2020 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with GNAT.Command_Line;
with Util.Test_Caller;
with Util.Commands.Parsers.GNAT_Parser;
with Util.Commands.Drivers;
package body Util.Commands.Tests is

   package Caller is new Util.Test_Caller (Test, "Commands");

   type Test_Context_Type is record
      Number  : Integer;
      Success : Boolean := False;
   end record;

   package Test_Command is new
     Util.Commands.Drivers (Context_Type => Test_Context_Type,
                            Config_Parser => Util.Commands.Parsers.GNAT_Parser.Config_Parser,
                            Driver_Name  => "test");

   type Test_Command_Type is new Test_Command.Command_Type with record
      Opt_Count : aliased Integer := 0;
      Opt_V     : aliased Boolean := False;
      Opt_N     : aliased Boolean := False;
      Expect_V  : Boolean := False;
      Expect_N  : Boolean := False;
      Expect_C  : Integer := 0;
      Expect_A  : Integer := 0;
      Expect_Help : Boolean := False;
   end record;

   overriding
   procedure Execute (Command   : in out Test_Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Test_Context_Type);

   --  Setup the command before parsing the arguments and executing it.
   procedure Setup (Command : in out Test_Command_Type;
                    Config  : in out GNAT.Command_Line.Command_Line_Configuration;
                    Context : in out Test_Context_Type);

   --  Write the help associated with the command.
   procedure Help (Command   : in out Test_Command_Type;
                   Name      : in String;
                   Context   : in out Test_Context_Type);

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Commands.Driver.Execute",
                       Test_Execute'Access);
      Caller.Add_Test (Suite, "Test Util.Commands.Driver.Help",
                       Test_Help'Access);
      Caller.Add_Test (Suite, "Test Util.Commands.Driver.Usage",
                       Test_Usage'Access);
   end Add_Tests;

   overriding
   procedure Execute (Command   : in out Test_Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Test_Context_Type) is
      pragma Unreferenced (Name);
   begin
      Context.Success := Command.Opt_Count = Command.Expect_C and
        Command.Opt_V = Command.Expect_V and
        Command.Opt_N = Command.Expect_N and
        Args.Get_Count = Command.Expect_A and
        not Command.Expect_Help;
   end Execute;

   --  ------------------------------
   --  Setup the command before parsing the arguments and executing it.
   --  ------------------------------
   procedure Setup (Command : in out Test_Command_Type;
                    Config  : in out GNAT.Command_Line.Command_Line_Configuration;
                    Context : in out Test_Context_Type) is
      pragma Unreferenced (Context);
   begin
      GNAT.Command_Line.Define_Switch (Config      => Config,
                                       Switch      => "-c:",
                                       Long_Switch => "--count=",
                                       Help        => "Number option",
                                       Section     => "",
                                       Initial     => Integer (0),
                                       Default     => Integer (10),
                                       Output      => Command.Opt_Count'Access);
      GNAT.Command_Line.Define_Switch (Config      => Config,
                                       Switch      => "-v",
                                       Long_Switch => "--verbose",
                                       Help        => "Verbose option",
                                       Section     => "",
                                       Output      => Command.Opt_V'Access);
      GNAT.Command_Line.Define_Switch (Config      => Config,
                                       Switch      => "-n",
                                       Long_Switch => "--not",
                                       Help        => "Not option",
                                       Section     => "",
                                       Output      => Command.Opt_N'Access);
   end Setup;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   procedure Help (Command   : in out Test_Command_Type;
                   Name      : in String;
                   Context   : in out Test_Context_Type) is
      pragma Unreferenced (Name);
   begin
      Context.Success := Command.Expect_Help;
   end Help;

   --  ------------------------------
   --  Tests when the execution of commands.
   --  ------------------------------
   procedure Test_Execute (T : in out Test) is
      C1    : aliased Test_Command_Type;
      C2    : aliased Test_Command_Type;
      D     : Test_Command.Driver_Type;
      Args  : String_Argument_List (500, 30);
   begin
      D.Set_Description ("Test command");
      D.Add_Command ("list", C1'Unchecked_Access);
      D.Add_Command ("print", C2'Unchecked_Access);

      declare
         Ctx   : Test_Context_Type;
      begin
         C1.Expect_V := True;
         C1.Expect_N := True;
         C1.Expect_C := 4;
         C1.Expect_A := 2;
         Initialize (Args, "list --count=4 -v -n test titi");
         D.Execute ("list", Args, Ctx);
         T.Assert (Ctx.Success, "Some arguments not parsed correctly");
      end;

      declare
         Ctx   : Test_Context_Type;
      begin
         C1.Expect_V := False;
         C1.Expect_N := True;
         C1.Expect_C := 8;
         C1.Expect_A := 3;
         Initialize (Args, "list -c 8 -n test titi last");
         D.Execute ("list", Args, Ctx);
         T.Assert (Ctx.Success, "Some arguments not parsed correctly");
      end;

   end Test_Execute;

   --  ------------------------------
   --  Test execution of help.
   --  ------------------------------
   procedure Test_Help (T : in out Test) is
      C1    : aliased Test_Command_Type;
      C2    : aliased Test_Command_Type;
      H     : aliased Test_Command.Help_Command_Type;
      D     : Test_Command.Driver_Type;
      Args  : String_Argument_List (500, 30);
   begin
      D.Set_Description ("Test command");
      D.Add_Command ("list", C1'Unchecked_Access);
      D.Add_Command ("print", C2'Unchecked_Access);
      D.Add_Command ("help", H'Unchecked_Access);
      declare
         Ctx   : Test_Context_Type;
      begin
         C1.Expect_Help := True;
         Initialize (Args, "help list");
         D.Execute ("help", Args, Ctx);
         T.Assert (Ctx.Success, "Some arguments not parsed correctly");
      end;

      declare
         Ctx   : Test_Context_Type;
      begin
         C2.Expect_Help := True;
         Initialize (Args, "help print");
         D.Execute ("help", Args, Ctx);
         T.Assert (Ctx.Success, "Some arguments not parsed correctly");
      end;

      declare
         Ctx   : Test_Context_Type;
      begin
         C1.Expect_Help := False;
         C2.Expect_Help := False;
         Initialize (Args, "help");
         D.Execute ("help", Args, Ctx);
         T.Assert (not Ctx.Success, "Some arguments not parsed correctly");
      end;

      declare
         Ctx   : Test_Context_Type;
      begin
         Initialize (Args, "help missing");
         D.Execute ("help", Args, Ctx);
         T.Fail ("No exception raised for missing command");

      exception
         when Not_Found =>
            null;
      end;
   end Test_Help;

   --  ------------------------------
   --  Test usage operation.
   --  ------------------------------
   procedure Test_Usage (T : in out Test) is
      C1    : aliased Test_Command_Type;
      C2    : aliased Test_Command_Type;
      H     : aliased Test_Command.Help_Command_Type;
      D     : Test_Command.Driver_Type;
      Args  : String_Argument_List (500, 30);
   begin
      D.Set_Description ("Test command");
      D.Add_Command ("list", C1'Unchecked_Access);
      D.Add_Command ("print", C2'Unchecked_Access);
      D.Add_Command ("help", H'Unchecked_Access);
      Args.Initialize (Line => "cmd list");
      declare
         Ctx   : Test_Context_Type;
      begin
         D.Usage (Args, Ctx);
         C1.Expect_Help := True;
         Initialize (Args, "help list");
         D.Execute ("help", Args, Ctx);
         T.Assert (Ctx.Success, "Some arguments not parsed correctly");

         D.Usage (Args, Ctx, "list");
      end;
   end Test_Usage;

end Util.Commands.Tests;

-----------------------------------------------------------------------
--  util-commands-tests - Test for commands
--  Copyright (C) 2018, 2019, 2020, 2022 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with GNAT.Command_Line;
with Util.Test_Caller;
with Util.Log;
with Util.Commands.Parsers.GNAT_Parser;
with Util.Commands.Drivers;
package body Util.Commands.Tests is

   package Caller is new Util.Test_Caller (Test, "Commands");

   type Test_Context_Type is record
      Number  : Integer := 0;
      Success : Boolean := False;
   end record;

   procedure Simple (Name : in String;
                     Args : in Argument_List'Class;
                     Ctx  : in out Test_Context_Type);

   package Test_Command is new
     Util.Commands.Drivers (Context_Type => Test_Context_Type,
                            Config_Parser => Util.Commands.Parsers.GNAT_Parser.Config_Parser,
                            Driver_Name  => "test");

   package Simple_Command is new
     Util.Commands.Drivers (Context_Type => Test_Context_Type,
                            Config_Parser => Util.Commands.Parsers.No_Parser,
                            Driver_Name  => "simple");

   type Test_Command_Type is new Test_Command.Command_Type with record
      Opt_Count : aliased Integer := 0;
      Opt_V     : aliased Boolean := False;
      Opt_N     : aliased Boolean := False;
      Expect_V  : Boolean := False;
      Expect_N  : Boolean := False;
      Expect_C  : Integer := 0;
      Expect_A  : Integer := 0;
      Expect_Help : Boolean := False;
   end record;

   overriding
   procedure Execute (Command   : in out Test_Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Test_Context_Type);

   --  Setup the command before parsing the arguments and executing it.
   procedure Setup (Command : in out Test_Command_Type;
                    Config  : in out GNAT.Command_Line.Command_Line_Configuration;
                    Context : in out Test_Context_Type);

   --  Write the help associated with the command.
   procedure Help (Command   : in out Test_Command_Type;
                   Name      : in String;
                   Context   : in out Test_Context_Type);

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Commands.Driver.Execute",
                       Test_Execute'Access);
      Caller.Add_Test (Suite, "Test Util.Commands.Driver.Help",
                       Test_Help'Access);
      Caller.Add_Test (Suite, "Test Util.Commands.Driver.Usage",
                       Test_Usage'Access);
      Caller.Add_Test (Suite, "Test Util.Commands.Driver.Add_Command",
                       Test_Simple_Command'Access);
   end Add_Tests;

   overriding
   procedure Execute (Command   : in out Test_Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Test_Context_Type) is
      pragma Unreferenced (Name);
   begin
      Command.Log (Util.Log.ERROR_LEVEL, "command", "execute command message");

      Context.Success := Command.Opt_Count = Command.Expect_C and
        Command.Opt_V = Command.Expect_V and
        Command.Opt_N = Command.Expect_N and
        Args.Get_Count = Command.Expect_A and
        not Command.Expect_Help;
   end Execute;

   --  ------------------------------
   --  Setup the command before parsing the arguments and executing it.
   --  ------------------------------
   procedure Setup (Command : in out Test_Command_Type;
                    Config  : in out GNAT.Command_Line.Command_Line_Configuration;
                    Context : in out Test_Context_Type) is
      pragma Unreferenced (Context);
   begin
      GNAT.Command_Line.Define_Switch (Config      => Config,
                                       Switch      => "-c:",
                                       Long_Switch => "--count=",
                                       Help        => "Number option",
                                       Section     => "",
                                       Initial     => Integer (0),
                                       Default     => Integer (10),
                                       Output      => Command.Opt_Count'Access);
      GNAT.Command_Line.Define_Switch (Config      => Config,
                                       Switch      => "-v",
                                       Long_Switch => "--verbose",
                                       Help        => "Verbose option",
                                       Section     => "",
                                       Output      => Command.Opt_V'Access);
      GNAT.Command_Line.Define_Switch (Config      => Config,
                                       Switch      => "-n",
                                       Long_Switch => "--not",
                                       Help        => "Not option",
                                       Section     => "",
                                       Output      => Command.Opt_N'Access);
   end Setup;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   procedure Help (Command   : in out Test_Command_Type;
                   Name      : in String;
                   Context   : in out Test_Context_Type) is
      pragma Unreferenced (Name);
   begin
      Context.Success := Command.Expect_Help;
   end Help;

   --  ------------------------------
   --  Tests when the execution of commands.
   --  ------------------------------
   procedure Test_Execute (T : in out Test) is
      C1    : aliased Test_Command_Type;
      C2    : aliased Test_Command_Type;
      D     : Test_Command.Driver_Type;
      Args  : String_Argument_List (500, 30);
   begin
      D.Set_Description ("Test command");
      D.Add_Command ("list", C1'Unchecked_Access);
      D.Add_Command ("print", C2'Unchecked_Access);

      declare
         Ctx   : Test_Context_Type;
      begin
         C1.Expect_V := True;
         C1.Expect_N := True;
         C1.Expect_C := 4;
         C1.Expect_A := 2;
         Initialize (Args, "list --count=4 -v -n test titi");
         D.Execute ("list", Args, Ctx);
         T.Assert (Ctx.Success, "Some arguments not parsed correctly");
      end;

      declare
         Ctx   : Test_Context_Type;
      begin
         C1.Expect_V := False;
         C1.Expect_N := True;
         C1.Expect_C := 8;
         C1.Expect_A := 3;
         Initialize (Args, "list -c 8 -n test titi last");
         D.Execute ("list", Args, Ctx);
         T.Assert (Ctx.Success, "Some arguments not parsed correctly");
      end;

      declare
         Ctx   : Test_Context_Type;
      begin
         C1.Expect_V := False;
         C1.Expect_N := True;
         C1.Expect_C := 8;
         C1.Expect_A := 3;
         Initialize (Args, "bad -c 8 -n test titi last");
         D.Execute ("bad", Args, Ctx);
         T.Fail ("No exception raised for missing command");

      exception
         when Not_Found =>
            null;
      end;
   end Test_Execute;

   --  ------------------------------
   --  Test execution of help.
   --  ------------------------------
   procedure Test_Help (T : in out Test) is
      C1    : aliased Test_Command_Type;
      C2    : aliased Test_Command_Type;
      H     : aliased Test_Command.Help_Command_Type;
      D     : Test_Command.Driver_Type;
      Args  : String_Argument_List (500, 30);
   begin
      D.Set_Description ("Test command");
      D.Add_Command ("list", C1'Unchecked_Access);
      D.Add_Command ("print", C2'Unchecked_Access);
      D.Add_Command ("help", H'Unchecked_Access);
      declare
         Ctx   : Test_Context_Type;
      begin
         C1.Expect_Help := True;
         Initialize (Args, "help list");
         D.Execute ("help", Args, Ctx);
         T.Assert (Ctx.Success, "Some arguments not parsed correctly");
      end;

      declare
         Ctx   : Test_Context_Type;
      begin
         C2.Expect_Help := True;
         Initialize (Args, "help print");
         D.Execute ("help", Args, Ctx);
         T.Assert (Ctx.Success, "Some arguments not parsed correctly");
      end;

      declare
         Ctx   : Test_Context_Type;
      begin
         C1.Expect_Help := False;
         C2.Expect_Help := False;
         Initialize (Args, "help");
         D.Execute ("help", Args, Ctx);
         T.Assert (not Ctx.Success, "Some arguments not parsed correctly");
      end;

      declare
         Ctx   : Test_Context_Type;
      begin
         Initialize (Args, "help missing");
         D.Execute ("help", Args, Ctx);
         T.Fail ("No exception raised for missing command");

      exception
         when Not_Found =>
            null;
      end;
   end Test_Help;

   --  ------------------------------
   --  Test usage operation.
   --  ------------------------------
   procedure Test_Usage (T : in out Test) is
      C1    : aliased Test_Command_Type;
      C2    : aliased Test_Command_Type;
      H     : aliased Test_Command.Help_Command_Type;
      D     : Test_Command.Driver_Type;
      Args  : String_Argument_List (500, 30);
   begin
      D.Set_Description ("Test command");
      D.Add_Command ("list", C1'Unchecked_Access);
      D.Add_Command ("print", C2'Unchecked_Access);
      D.Add_Command ("help", H'Unchecked_Access);
      Args.Initialize (Line => "cmd list");
      declare
         Ctx   : Test_Context_Type;
      begin
         D.Usage (Args, Ctx);
         C1.Expect_Help := True;
         Initialize (Args, "help list");
         D.Execute ("help", Args, Ctx);
         T.Assert (Ctx.Success, "Some arguments not parsed correctly");

         D.Usage (Args, Ctx, "list");
      end;
   end Test_Usage;

   procedure Simple (Name : in String;
                     Args : in Argument_List'Class;
                     Ctx  : in out Test_Context_Type) is
      pragma Unreferenced (Name, Args);
   begin
      Ctx.Number := 1;
      Ctx.Success := True;
   end Simple;

   --  Test command based on the No_Parser.
   procedure Test_Simple_Command (T : in out Test) is
      D    : Simple_Command.Driver_Type;
      Args : String_Argument_List (500, 30);
   begin
      D.Add_Command ("list", "list command", Simple'Access);

      declare
         Ctx   : Test_Context_Type;
      begin
         Initialize (Args, "list --count=4 -v -n test titi");
         D.Execute ("list", Args, Ctx);
         T.Assert (Ctx.Success, "Some arguments not parsed correctly");
         Util.Tests.Assert_Equals (T, 1, Ctx.Number, "Invalid context number");

         D.Usage (Args, Ctx, "list");
      end;

   end Test_Simple_Command;

end Util.Commands.Tests;

Add Test_Simple_Command and register the new test for execution


-----------------------------------------------------------------------
--  mat-events-timelines - Timelines
--  Copyright (C) 2015 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Containers.Vectors;

with MAT.Expressions;
with MAT.Events.Targets;
package MAT.Events.Timelines is

   --  Describe a section of the timeline.  The section has a starting and ending
   --  event that marks the boundary of the section within the collected events.
   --  The timeline section gives the duration and some statistics about memory
   --  allocation made in the section.
   type Timeline_Info is record
      First_Event    : MAT.Events.Targets.Probe_Event_Type;
      Last_Event     : MAT.Events.Targets.Probe_Event_Type;
      Duration       : MAT.Types.Target_Time := 0;
      Malloc_Count   : Natural := 0;
      Realloc_Count  : Natural := 0;
      Free_Count     : Natural := 0;
   end record;

   package Timeline_Info_Vectors is
     new Ada.Containers.Vectors (Positive, Timeline_Info);

   subtype Timeline_Info_Vector is Timeline_Info_Vectors.Vector;
   subtype Timeline_Info_Cursor is Timeline_Info_Vectors.Cursor;

   procedure Extract (Target : in out MAT.Events.Targets.Target_Events'Class;
                      Into   : in out Timeline_Info_Vector);

   --  Find in the events stream the events which are associated with a given event.
   --  When the <tt>Event</tt> is a memory allocation, find the associated reallocation
   --  and free events.  When the event is a free, find the associated allocations.
   --  Collect at most <tt>Max</tt> events.
   procedure Find_Related (Target : in out MAT.Events.Targets.Target_Events'Class;
                           Event  : in MAT.Events.Targets.Probe_Event_Type;
                           Max    : in Positive;
                           List   : in out MAT.Events.Targets.Target_Event_Vector);

   --  Find the sizes of malloc and realloc events which is selected by the given filter.
   --  Update the <tt>Sizes</tt> map to keep track of the first event and last event and
   --  the number of events found for the corresponding size.
   procedure Find_Sizes (Target : in out MAT.Events.Targets.Target_Events'Class;
                         Filter : in MAT.Expressions.Expression_Type;
                         Sizes  : in out MAT.Events.Targets.Size_Event_Info_Map);

   --  Find the function address from the call event frames for the events which is selected
   --  by the given filter.  The function addresses are collected up to the given frame depth.
   --  Update the <tt>Frames</tt> map to keep track of the first event and last event and
   --  the number of events found for the corresponding frame address.
   procedure Find_Frames (Target : in out MAT.Events.Targets.Target_Events'Class;
                          Filter : in MAT.Expressions.Expression_Type;
                          Depth  : in Natural;
                          Frames : in out MAT.Events.Targets.Frame_Event_Info_Map);

end MAT.Events.Timelines;

-----------------------------------------------------------------------
--  mat-events-timelines - Timelines
--  Copyright (C) 2015 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Containers.Vectors;

with MAT.Expressions;
with MAT.Events.Targets;
package MAT.Events.Timelines is

   --  Describe a section of the timeline.  The section has a starting and ending
   --  event that marks the boundary of the section within the collected events.
   --  The timeline section gives the duration and some statistics about memory
   --  allocation made in the section.
   type Timeline_Info is record
      First_Event    : MAT.Events.Targets.Probe_Event_Type;
      Last_Event     : MAT.Events.Targets.Probe_Event_Type;
      Duration       : MAT.Types.Target_Time := 0;
      Malloc_Count   : Natural := 0;
      Realloc_Count  : Natural := 0;
      Free_Count     : Natural := 0;
      Alloc_Size     : MAT.Types.Target_Size := 0;
      Free_Size      : MAT.Types.Target_Size := 0;
   end record;

   package Timeline_Info_Vectors is
     new Ada.Containers.Vectors (Positive, Timeline_Info);

   subtype Timeline_Info_Vector is Timeline_Info_Vectors.Vector;
   subtype Timeline_Info_Cursor is Timeline_Info_Vectors.Cursor;

   procedure Extract (Target : in out MAT.Events.Targets.Target_Events'Class;
                      Into   : in out Timeline_Info_Vector);

   --  Find in the events stream the events which are associated with a given event.
   --  When the <tt>Event</tt> is a memory allocation, find the associated reallocation
   --  and free events.  When the event is a free, find the associated allocations.
   --  Collect at most <tt>Max</tt> events.
   procedure Find_Related (Target : in out MAT.Events.Targets.Target_Events'Class;
                           Event  : in MAT.Events.Targets.Probe_Event_Type;
                           Max    : in Positive;
                           List   : in out MAT.Events.Targets.Target_Event_Vector);

   --  Find the sizes of malloc and realloc events which is selected by the given filter.
   --  Update the <tt>Sizes</tt> map to keep track of the first event and last event and
   --  the number of events found for the corresponding size.
   procedure Find_Sizes (Target : in out MAT.Events.Targets.Target_Events'Class;
                         Filter : in MAT.Expressions.Expression_Type;
                         Sizes  : in out MAT.Events.Targets.Size_Event_Info_Map);

   --  Find the function address from the call event frames for the events which is selected
   --  by the given filter.  The function addresses are collected up to the given frame depth.
   --  Update the <tt>Frames</tt> map to keep track of the first event and last event and
   --  the number of events found for the corresponding frame address.
   procedure Find_Frames (Target : in out MAT.Events.Targets.Target_Events'Class;
                          Filter : in MAT.Expressions.Expression_Type;
                          Depth  : in Natural;
                          Frames : in out MAT.Events.Targets.Frame_Event_Info_Map);

end MAT.Events.Timelines;

Add Alloc_Size and Free_Size in the Timeline_Info record


-----------------------------------------------------------------------
--  mat-symbols-targets - Symbol files management
--  Copyright (C) 2014, 2015 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Strings.Unbounded;
with Ada.Containers.Ordered_Maps;

with Bfd.Symbols;
with Bfd.Files;
with Bfd.Constants;

with Util.Refs;

with MAT.Types;
with MAT.Consoles;
with MAT.Memory;
package MAT.Symbols.Targets is

   type Symbol_Info is record
      File : Ada.Strings.Unbounded.Unbounded_String;
      Name : Ada.Strings.Unbounded.Unbounded_String;
      Line : Natural;
   end record;

   --  The <tt>Region_Symbols</tt> holds the symbol table associated with the program or
   --  a shared library loaded by the program.  The <tt>Region</tt> indicates
   --  the text segment address of the program or the loaded library.
   type Region_Symbols is new Util.Refs.Ref_Entity with record
      Region     : MAT.Memory.Region_Info;
      Offset     : MAT.Types.Target_Addr;
      File       : Bfd.Files.File_Type;
      Symbols    : Bfd.Symbols.Symbol_Table;
   end record;
   type Region_Symbols_Access is access all Region_Symbols;

   --  Load the symbol table for the associated region.
   procedure Open (Symbols : in out Region_Symbols;
                   Path    : in String);

   package Region_Symbols_Refs is
     new Util.Refs.References (Region_Symbols, Region_Symbols_Access);

   subtype Region_Symbols_Ref is Region_Symbols_Refs.Ref;

   --  The <tt>Symbols_Maps</tt> keeps a sorted list of symbol tables indexed
   --  by their mapping address.
   use type Region_Symbols_Refs.Ref;
   use type MAT.Types.Target_Addr;
   package Symbols_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Addr,
                                      Element_Type => Region_Symbols_Ref);

   subtype Symbols_Map is Symbols_Maps.Map;
   subtype Symbols_Cursor is Symbols_Maps.Cursor;

   type Target_Symbols is new Util.Refs.Ref_Entity with record
      Path      : Ada.Strings.Unbounded.Unbounded_String;
      File      : Bfd.Files.File_Type;
      Symbols   : Bfd.Symbols.Symbol_Table;
      Libraries : Symbols_Maps.Map;
      Demangle  : Bfd.Demangle_Flags := Bfd.Constants.DMGL_AUTO;
      Console   : MAT.Consoles.Console_Access;
   end record;
   type Target_Symbols_Access is access all Target_Symbols;

   --  Open the binary and load the symbols from that file.
   procedure Open (Symbols : in out Target_Symbols;
                   Path    : in String);

   --  Load the symbols associated with a shared library described by the memory region.
   procedure Load_Symbols (Symbols     : in out Target_Symbols;
                           Region      : in MAT.Memory.Region_Info;
                           Offset_Addr : in MAT.Types.Target_Addr);

   --  Load the symbols associated with all the shared libraries described by
   --  the memory region map.
   procedure Load_Symbols (Symbols     : in out Target_Symbols;
                           Regions     : in MAT.Memory.Region_Info_Map);

   --  Demangle the symbol.
   procedure Demangle (Symbols : in Target_Symbols;
                       Symbol  : in out Symbol_Info);

   --  Find the nearest source file and line for the given address.
   procedure Find_Nearest_Line (Symbols : in Target_Symbols;
                                Addr    : in MAT.Types.Target_Addr;
                                Symbol  : out Symbol_Info);

   package Target_Symbols_Refs is
     new Util.Refs.References (Target_Symbols, Target_Symbols_Access);

   subtype Target_Symbols_Ref is Target_Symbols_Refs.Ref;

end MAT.Symbols.Targets;

-----------------------------------------------------------------------
--  mat-symbols-targets - Symbol files management
--  Copyright (C) 2014, 2015 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Strings.Unbounded;
with Ada.Containers.Ordered_Maps;

with Bfd.Symbols;
with Bfd.Files;
with Bfd.Constants;

with Util.Refs;

with MAT.Types;
with MAT.Consoles;
with MAT.Memory;
package MAT.Symbols.Targets is

   --  The <tt>Region_Symbols</tt> holds the symbol table associated with the program or
   --  a shared library loaded by the program.  The <tt>Region</tt> indicates
   --  the text segment address of the program or the loaded library.
   type Region_Symbols is new Util.Refs.Ref_Entity with record
      Region     : MAT.Memory.Region_Info;
      Offset     : MAT.Types.Target_Addr;
      File       : Bfd.Files.File_Type;
      Symbols    : Bfd.Symbols.Symbol_Table;
   end record;
   type Region_Symbols_Access is access all Region_Symbols;

   --  Load the symbol table for the associated region.
   procedure Open (Symbols : in out Region_Symbols;
                   Path    : in String);

   package Region_Symbols_Refs is
     new Util.Refs.References (Region_Symbols, Region_Symbols_Access);

   subtype Region_Symbols_Ref is Region_Symbols_Refs.Ref;

   type Symbol_Info is limited record
      File    : Ada.Strings.Unbounded.Unbounded_String;
      Name    : Ada.Strings.Unbounded.Unbounded_String;
      Line    : Natural;
      Symbols : Region_Symbols_Ref;
   end record;

   --  The <tt>Symbols_Maps</tt> keeps a sorted list of symbol tables indexed
   --  by their mapping address.
   use type Region_Symbols_Refs.Ref;
   use type MAT.Types.Target_Addr;
   package Symbols_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Addr,
                                      Element_Type => Region_Symbols_Ref);

   subtype Symbols_Map is Symbols_Maps.Map;
   subtype Symbols_Cursor is Symbols_Maps.Cursor;

   type Target_Symbols is new Util.Refs.Ref_Entity with record
      Path      : Ada.Strings.Unbounded.Unbounded_String;
      File      : Bfd.Files.File_Type;
      Symbols   : Bfd.Symbols.Symbol_Table;
      Libraries : Symbols_Maps.Map;
      Demangle  : Bfd.Demangle_Flags := Bfd.Constants.DMGL_AUTO;
      Console   : MAT.Consoles.Console_Access;
   end record;
   type Target_Symbols_Access is access all Target_Symbols;

   --  Open the binary and load the symbols from that file.
   procedure Open (Symbols : in out Target_Symbols;
                   Path    : in String);

   --  Load the symbols associated with a shared library described by the memory region.
   procedure Load_Symbols (Symbols     : in out Target_Symbols;
                           Region      : in MAT.Memory.Region_Info;
                           Offset_Addr : in MAT.Types.Target_Addr);

   --  Load the symbols associated with all the shared libraries described by
   --  the memory region map.
   procedure Load_Symbols (Symbols     : in out Target_Symbols;
                           Regions     : in MAT.Memory.Region_Info_Map);

   --  Demangle the symbol.
   procedure Demangle (Symbols : in Target_Symbols;
                       Symbol  : in out Symbol_Info);

   --  Find the nearest source file and line for the given address.
   procedure Find_Nearest_Line (Symbols : in Target_Symbols;
                                Addr    : in MAT.Types.Target_Addr;
                                Symbol  : out Symbol_Info);

   package Target_Symbols_Refs is
     new Util.Refs.References (Target_Symbols, Target_Symbols_Access);

   subtype Target_Symbols_Ref is Target_Symbols_Refs.Ref;

end MAT.Symbols.Targets;

Change Symbol_Info to a limited type (because we don't need the copy) and add a reference to the Region_Symbols object


-----------------------------------------------------------------------
--  awa-comments-module -- Comments module
--  Copyright (C) 2011, 2012, 2013, 2014 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Calendar;

with Util.Log.Loggers;

with ADO.Sessions;
with ADO.Sessions.Entities;
with Security.Permissions;

with AWA.Users.Models;
with AWA.Permissions;
with AWA.Modules.Beans;
with AWA.Services.Contexts;
with AWA.Comments.Beans;

package body AWA.Comments.Modules is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Comments.Module");

   package Register is new AWA.Modules.Beans (Module        => Comment_Module,
                                              Module_Access => Comment_Module_Access);

   --  ------------------------------
   --  Initialize the comments module.
   --  ------------------------------
   overriding
   procedure Initialize (Plugin : in out Comment_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config) is
   begin
      Log.Info ("Initializing the comments module");

      --  Setup the resource bundles.
      App.Register ("commentMsg", "comments");

      --  Register the comment list bean.
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Comments.Beans.Comment_List_Bean",
                         Handler => AWA.Comments.Beans.Create_Comment_List_Bean'Access);

      --  Register the comment bean.
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Comments.Beans.Comment_Bean",
                         Handler => AWA.Comments.Beans.Create_Comment_Bean'Access);

      AWA.Modules.Module (Plugin).Initialize (App, Props);
   end Initialize;

   --  ------------------------------
   --  Load the comment identified by the given identifier.
   --  ------------------------------
   procedure Load_Comment (Model   : in Comment_Module;
                           Comment : in out AWA.Comments.Models.Comment_Ref'Class;
                           Id      : in ADO.Identifier) is
      pragma Unreferenced (Model);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Session := AWA.Services.Contexts.Get_Session (Ctx);
      Found : Boolean;
   begin
      Comment.Load (DB, Id, Found);
   end Load_Comment;

   --  ------------------------------
   --  Create a new comment for the associated database entity.
   --  ------------------------------
   procedure Create_Comment (Model       : in Comment_Module;
                             Permission  : in String;
                             Entity_Type : in String;
                             Comment     : in out AWA.Comments.Models.Comment_Ref'Class) is
      pragma Unreferenced (Model);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant AWA.Users.Models.User_Ref := Ctx.Get_User;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      Ctx.Start;
      Log.Info ("Creating new comment for {0}", ADO.Identifier'Image (Comment.Get_Entity_Id));

      --  Check that the user has the create permission on the given workspace.
      AWA.Permissions.Check (Permission => Security.Permissions.Get_Permission_Index (Permission),
                             Entity     => Comment.Get_Entity_Id);

      Comment.Set_Entity_Type (ADO.Sessions.Entities.Find_Entity_Type (DB, Entity_Type));
      Comment.Set_Author (User);
      Comment.Set_Create_Date (Ada.Calendar.Clock);
      Comment.Save (DB);
      Ctx.Commit;
   end Create_Comment;

   --  ------------------------------
   --  Update the comment represented by <tt>Comment</tt> if the current user has the
   --  permission identified by <tt>Permission</tt>.
   --  ------------------------------
   procedure Update_Comment (Model       : in Comment_Module;
                             Permission  : in String;
                             Comment     : in out AWA.Comments.Models.Comment_Ref'Class) is
      pragma Unreferenced (Model);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      if not Comment.Is_Inserted then
         Log.Error ("The comment was not created");
         raise Not_Found with "The comment was not inserted";
      end if;
      Ctx.Start;
      Log.Info ("Updating the comment {0}", ADO.Identifier'Image (Comment.Get_Id));

      --  Check that the user has the update permission on the given comment.
      AWA.Permissions.Check (Permission => Security.Permissions.Get_Permission_Index (Permission),
                             Entity     => Comment);
      Comment.Save (DB);
      Ctx.Commit;
   end Update_Comment;

   --  ------------------------------
   --  Delete the comment represented by <tt>Comment</tt> if the current user has the
   --  permission identified by <tt>Permission</tt>.
   --  ------------------------------
   procedure Delete_Comment (Model       : in Comment_Module;
                             Permission  : in String;
                             Comment     : in out AWA.Comments.Models.Comment_Ref'Class) is
      pragma Unreferenced (Model);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      Ctx.Start;

      --  Check that the user has the delete permission on the given answer.
      AWA.Permissions.Check (Permission => Security.Permissions.Get_Permission_Index (Permission),
                             Entity     => Comment);

      Comment.Delete (DB);
      Ctx.Commit;
   end Delete_Comment;

end AWA.Comments.Modules;

-----------------------------------------------------------------------
--  awa-comments-module -- Comments module
--  Copyright (C) 2011, 2012, 2013, 2014 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Calendar;

with Util.Log.Loggers;

with ADO.Sessions;
with ADO.Sessions.Entities;
with Security.Permissions;

with AWA.Users.Models;
with AWA.Permissions;
with AWA.Modules.Beans;
with AWA.Services.Contexts;
with AWA.Comments.Beans;

package body AWA.Comments.Modules is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Comments.Module");

   package Register is new AWA.Modules.Beans (Module        => Comment_Module,
                                              Module_Access => Comment_Module_Access);

   --  ------------------------------
   --  Initialize the comments module.
   --  ------------------------------
   overriding
   procedure Initialize (Plugin : in out Comment_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config) is
   begin
      Log.Info ("Initializing the comments module");

      --  Setup the resource bundles.
      App.Register ("commentMsg", "comments");

      --  Register the comment list bean.
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Comments.Beans.Comment_List_Bean",
                         Handler => AWA.Comments.Beans.Create_Comment_List_Bean'Access);

      --  Register the comment bean.
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Comments.Beans.Comment_Bean",
                         Handler => AWA.Comments.Beans.Create_Comment_Bean'Access);

      AWA.Modules.Module (Plugin).Initialize (App, Props);
   end Initialize;

   --  ------------------------------
   --  Load the comment identified by the given identifier.
   --  ------------------------------
   procedure Load_Comment (Model   : in Comment_Module;
                           Comment : in out AWA.Comments.Models.Comment_Ref'Class;
                           Id      : in ADO.Identifier) is
      pragma Unreferenced (Model);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Session := AWA.Services.Contexts.Get_Session (Ctx);
      Found : Boolean;
   begin
      Comment.Load (DB, Id, Found);
   end Load_Comment;

   --  ------------------------------
   --  Create a new comment for the associated database entity.
   --  ------------------------------
   procedure Create_Comment (Model       : in Comment_Module;
                             Permission  : in String;
                             Entity_Type : in String;
                             Comment     : in out AWA.Comments.Models.Comment_Ref'Class) is
      pragma Unreferenced (Model);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant AWA.Users.Models.User_Ref := Ctx.Get_User;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      Ctx.Start;
      Log.Info ("Creating new comment for {0}", ADO.Identifier'Image (Comment.Get_Entity_Id));

      --  Check that the user has the create permission on the given workspace.
      AWA.Permissions.Check (Permission => Security.Permissions.Get_Permission_Index (Permission),
                             Entity     => Comment.Get_Entity_Id);

      Comment.Set_Entity_Type (ADO.Sessions.Entities.Find_Entity_Type (DB, Entity_Type));
      Comment.Set_Author (User);
      Comment.Set_Create_Date (Ada.Calendar.Clock);
      Comment.Save (DB);
      Ctx.Commit;
   end Create_Comment;

   --  ------------------------------
   --  Update the comment represented by <tt>Comment</tt> if the current user has the
   --  permission identified by <tt>Permission</tt>.
   --  ------------------------------
   procedure Update_Comment (Model       : in Comment_Module;
                             Permission  : in String;
                             Comment     : in out AWA.Comments.Models.Comment_Ref'Class) is
      pragma Unreferenced (Model);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      if not Comment.Is_Inserted then
         Log.Error ("The comment was not created");
         raise Not_Found with "The comment was not inserted";
      end if;
      Ctx.Start;
      Log.Info ("Updating the comment {0}", ADO.Identifier'Image (Comment.Get_Id));

      --  Check that the user has the update permission on the given comment.
      AWA.Permissions.Check (Permission => Security.Permissions.Get_Permission_Index (Permission),
                             Entity     => Comment);
      Comment.Save (DB);
      Ctx.Commit;
   end Update_Comment;

   --  ------------------------------
   --  Delete the comment represented by <tt>Comment</tt> if the current user has the
   --  permission identified by <tt>Permission</tt>.
   --  ------------------------------
   procedure Delete_Comment (Model       : in Comment_Module;
                             Permission  : in String;
                             Comment     : in out AWA.Comments.Models.Comment_Ref'Class) is
      pragma Unreferenced (Model);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      Ctx.Start;

      --  Check that the user has the delete permission on the given answer.
      AWA.Permissions.Check (Permission => Security.Permissions.Get_Permission_Index (Permission),
                             Entity     => Comment);

      Comment.Delete (DB);
      Ctx.Commit;
   end Delete_Comment;

   --  ------------------------------
   --  Set the publication status of the comment represented by <tt>Comment</tt>
   --  if the current user has the permission identified by <tt>Permission</tt>.
   --  ------------------------------
   procedure Publish_Comment (Model       : in Comment_Module;
                              Permission  : in String;
                              Id          : in ADO.Identifier;
                              Status      : in AWA.Comments.Models.Status_Type;
                              Comment     : in out AWA.Comments.Models.Comment_Ref'Class) is
      pragma Unreferenced (Model);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      Ctx.Start;

      --  Check that the user has the permission to publish for the given comment.
      AWA.Permissions.Check (Permission => Security.Permissions.Get_Permission_Index (Permission),
                             Entity     => Id);

      Comment.Load (DB, Id);
      Comment.Set_Status (Status);
      Comment.Save (DB);
      Ctx.Commit;
   end Publish_Comment;

end AWA.Comments.Modules;

Implement the Publish_Comment operation, check the permission, load the comment, change the status and return the comment instance