-----------------------------------------------------------------------
--  security-permissions -- Definition of permissions
--  Copyright (C) 2010, 2011 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.Finalization;
with Ada.Strings.Unbounded;

with Ada.Containers.Hashed_Maps;
with Ada.Containers.Vectors;

with Util.Strings;
with Util.Refs;
with Util.Beans.Objects;
with Util.Beans.Objects.Vectors;
with Util.Serialize.IO.XML;

with GNAT.Regexp;

--  with EL.Functions;

limited with Security.Controllers;
limited with Security.Contexts;

--  The Security.Permissions package defines the different permissions that can be
--  checked by the access control manager.
package Security.Permissions is

   --  EL function name exposed by Set_Functions.
   HAS_PERMISSION_FN  : constant String := "hasPermission";

   --  URI for the EL functions exposed by the security package (See Set_Functions).
   AUTH_NAMESPACE_URI : constant String := "http://code.google.com/p/ada-asf/auth";

   Invalid_Name : exception;

   type Security_Context_Access is access all Contexts.Security_Context'Class;

   type Permission_Index is new Natural;

   type Controller_Access is access all Security.Controllers.Controller'Class;

   type Controller_Access_Array is array (Permission_Index range <>) of Controller_Access;

   --  Get the permission index associated with the name.
   function Get_Permission_Index (Name : in String) return Permission_Index;

   --  Get the last permission index registered in the global permission map.
   function Get_Last_Permission_Index return Permission_Index;

   --  Add the permission name and allocate a unique permission index.
   procedure Add_Permission (Name  : in String;
                             Index : out Permission_Index);

   --  The permission root class.
   type Abstract_Permission is abstract tagged limited null record;

   --  Each role is represented by a Role_Type number to provide a fast
   --  and efficient role check.
   type Role_Type is new Natural range 0 .. 63;

   type Role_Type_Array is array (Positive range <>) of Role_Type;

   --  The Role_Map represents a set of roles which are assigned to a user.
   --  Each role is represented by a boolean in the map.  The implementation is limited
   --  to 64 roles (the number of different permissions can be higher).
   type Role_Map is array (Role_Type'Range) of Boolean;
   pragma Pack (Role_Map);

   --  Each permission is represented by a Permission_Type number to provide a fast
   --  and efficient permission check.
   type Permission_Type is new Natural range 0 .. 63;

   --  The Permission_Map represents a set of permissions which are granted to a user.
   --  Each permission is represented by a boolean in the map.  The implementation is limited
   --  to 64 permissions.
   type Permission_Map is array (Permission_Type'Range) of Boolean;
   pragma Pack (Permission_Map);

   --  ------------------------------
   --  Principal
   --  ------------------------------
   type Principal is limited interface;
   type Principal_Access is access all Principal'Class;

   --  Returns true if the given role is stored in the user principal.
   function Has_Role (User : in Principal;
                      Role : in Role_Type) return Boolean is abstract;

   --  Get the principal name.
   function Get_Name (From : in Principal) return String is abstract;

   --  ------------------------------
   --  Permission
   --  ------------------------------

   --  Represents a permission for a given role.
   type Permission (Role : Permission_Type) is new Abstract_Permission with null record;

   --  ------------------------------
   --  URI Permission
   --  ------------------------------
   --  Represents a permission to access a given URI.
   type URI_Permission (Len : Natural) is new Abstract_Permission with record
      URI : String (1 .. Len);
   end record;

   --  ------------------------------
   --  File Permission
   --  ------------------------------

   type File_Mode is (READ, WRITE);

   --  Represents a permission to access a given file.
   type File_Permission (Len  : Natural;
                         Mode : File_Mode) is new Abstract_Permission with record
      Path : String (1 .. Len);
   end record;

   --  ------------------------------
   --  Permission Manager
   --  ------------------------------
   --  The Permission_Manager verifies through some policy that a permission
   --  is granted to a user.
   type Permission_Manager is new Ada.Finalization.Limited_Controlled with private;
   type Permission_Manager_Access is access all Permission_Manager'Class;

   procedure Add_Permission (Manager    : in out Permission_Manager;
                             Name       : in String;
                             Permission : in Controller_Access);

   --  Find the role type associated with the role name identified by Name.
   --  Raises Invalid_Name if there is no role type.
   function Find_Role (Manager : in Permission_Manager;
                       Name    : in String) return Role_Type;

   --  Returns True if the user has the permission to access the given URI permission.
   function Has_Permission (Manager    : in Permission_Manager;
                            Context    : in Security_Context_Access;
                            Permission : in URI_Permission'Class) return Boolean;

   --  Returns True if the user has the given role permission.
   function Has_Permission (Manager    : in Permission_Manager;
                            User       : in Principal'Class;
                            Permission : in Permission_Type) return Boolean;

   --  Get the security controller associated with the permission index Index.
   --  Returns null if there is no such controller.
   function Get_Controller (Manager : in Permission_Manager'Class;
                            Index   : in Permission_Index) return Controller_Access;
   pragma Inline_Always (Get_Controller);

   --  Get the role name.
   function Get_Role_Name (Manager : in Permission_Manager;
                           Role    : in Role_Type) return String;

   --  Create a role
   procedure Create_Role (Manager : in out Permission_Manager;
                          Name    : in String;
                          Role    : out Role_Type);

   --  Get or add a role type for the given name.
   procedure Add_Role_Type (Manager   : in out Permission_Manager;
                            Name      : in String;
                            Result    : out Role_Type);

   --  Grant the permission to access to the given URI to users having the To
   --  permissions.
   procedure Grant_URI_Permission (Manager : in out Permission_Manager;
                                   URI     : in String;
                                   To      : in String);

   --  Grant the permission to access to the given Path to users having the To
   --  permissions.
   procedure Grant_File_Permission (Manager : in out Permission_Manager;
                                    Path    : in String;
                                    To      : in String);

   --  Read the policy file
   procedure Read_Policy (Manager : in out Permission_Manager;
                          File    : in String);

   --  Initialize the permission manager.
   overriding
   procedure Initialize (Manager : in out Permission_Manager);

   --  Finalize the permission manager.
   overriding
   procedure Finalize (Manager : in out Permission_Manager);

   generic
      Name : String;
   package Permission_ACL is
      function Permission return Permission_Index;
      pragma Inline_Always (Permission);
   end Permission_ACL;

   --  ------------------------------
   --  Policy Configuration
   --  ------------------------------
   type Policy_Config is record
      Id          : Natural := 0;
      Permissions : Util.Beans.Objects.Vectors.Vector;
      Patterns    : Util.Beans.Objects.Vectors.Vector;
      Manager     : Permission_Manager_Access;
   end record;
   type Policy_Config_Access is access all Policy_Config;

   --  Setup the XML parser to read the policy description.  For example:
   --
   --  <policy id='1'>
   --     <permission>create-workspace</permission>
   --     <permission>admin</permission>
   --     <url-pattern>/workspace/create</url-pattern>
   --     <url-pattern>/workspace/setup/*</url-pattern>
   --  </policy>
   --
   --  This policy gives access to the URL that match one of the URL pattern if the
   --  security context has the permission create-workspace or admin.
   generic
      Reader  : in out Util.Serialize.IO.XML.Parser;
      Manager : in Security.Permissions.Permission_Manager_Access;
   package Reader_Config is
      Config : aliased Policy_Config;
   end Reader_Config;

   --  Register a set of functions in the namespace
   --  xmlns:fn="http://code.google.com/p/ada-asf/auth"
   --  Functions:
   --    hasPermission(NAME)   --  Returns True if the permission NAME is granted
   --  procedure Set_Functions (Mapper : in out EL.Functions.Function_Mapper'Class);

private

   use Util.Strings;

   type Role_Name_Array is
     array (Role_Type'Range) of Ada.Strings.Unbounded.String_Access;

   type Permission_Type_Array is array (1 .. 10) of Permission_Type;

   type Permission_Index_Array is array (Positive range <>) of Permission_Index;

   --  The Access_Rule represents a list of permissions to verify to grant
   --  access to the resource.  To make it simple, the user must have one of the
   --  permission from the list.  Each permission will refer to a specific permission
   --  controller.
   type Access_Rule (Count : Natural) is new Util.Refs.Ref_Entity with record
      Permissions : Permission_Index_Array (1 .. Count);
   end record;
   type Access_Rule_Access is access all Access_Rule;

   package Access_Rule_Refs is
     new Util.Refs.Indefinite_References (Element_Type   => Access_Rule,
                                          Element_Access => Access_Rule_Access);
   subtype Access_Rule_Ref is Access_Rule_Refs.Ref;

   --  No rule
--     No_Rule : constant Access_Rule := (Count => 0,
--                                        Permissions => (others => Permission_Index'First));

   --  Find the access rule of the policy that matches the given URI.
   --  Returns the No_Rule value (disable access) if no rule is found.
   function Find_Access_Rule (Manager : in Permission_Manager;
                              URI     : in String) return Access_Rule_Ref;

   --  The Policy defines the access rules that are applied on a given
   --  URL, set of URLs or files.
   type Policy is record
      Id      : Natural;
      Pattern : GNAT.Regexp.Regexp;
      Rule    : Access_Rule_Ref;
   end record;

   --  The Policy_Vector represents the whole permission policy.  The order of
   --  policy in the list is important as policies can override each other.
   package Policy_Vector is new Ada.Containers.Vectors (Index_Type   => Positive,
                                                        Element_Type => Policy);

   package Rules_Maps is new Ada.Containers.Hashed_Maps (Key_Type        => String_Ref,
                                                         Element_Type    => Access_Rule_Ref,
                                                         Hash            => Hash,
                                                         Equivalent_Keys => Equivalent_Keys,
                                                         "="             => Access_Rule_Refs."=");

   type Rules is new Util.Refs.Ref_Entity with record
      Map : Rules_Maps.Map;
   end record;
   type Rules_Access is access all Rules;

   package Rules_Ref is new Util.Refs.References (Rules, Rules_Access);

   type Rules_Ref_Access is access Rules_Ref.Atomic_Ref;

   type Controller_Access_Array_Access is access all Controller_Access_Array;

   type Permission_Manager is new Ada.Finalization.Limited_Controlled with record
      Names        : Role_Name_Array;
      Cache        : Rules_Ref_Access;
      Next_Role    : Role_Type := Role_Type'First;
      Policies     : Policy_Vector.Vector;
      Permissions  : Controller_Access_Array_Access;
      Last_Index   : Permission_Index := Permission_Index'First;
   end record;

   --  EL function to check if the given permission name is granted by the current
   --  security context.
   function Has_Permission (Value : in Util.Beans.Objects.Object)
                            return Util.Beans.Objects.Object;

end Security.Permissions;

-----------------------------------------------------------------------
--  security-permissions -- Definition of permissions
--  Copyright (C) 2010, 2011 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.Finalization;
with Ada.Strings.Unbounded;

with Ada.Containers.Hashed_Maps;
with Ada.Containers.Vectors;

with Util.Strings;
with Util.Refs;
with Util.Beans.Objects;
with Util.Beans.Objects.Vectors;
with Util.Serialize.IO.XML;

with GNAT.Regexp;

limited with Security.Controllers;
limited with Security.Contexts;

--  == Permissions ==
--  The Security.Permissions package defines the different permissions that can be
--  checked by the access control manager.
--
--  === Principal ===
--  The <tt>Principal</tt> is the entity that can be authenticated.  A principal is obtained
--  after successful authentication of a user or of a system through an authorization process.
--  The OpenID or OAuth authentication processes generate such security principal.
--
--  === Permission ===
--  The <tt>Permission</tt> represents an access to a system or application resource.
--
package Security.Permissions is

   --  EL function name exposed by Set_Functions.
   HAS_PERMISSION_FN  : constant String := "hasPermission";

   --  URI for the EL functions exposed by the security package (See Set_Functions).
   AUTH_NAMESPACE_URI : constant String := "http://code.google.com/p/ada-asf/auth";

   Invalid_Name : exception;

   type Security_Context_Access is access all Contexts.Security_Context'Class;

   type Permission_Index is new Natural;

   type Controller_Access is access all Security.Controllers.Controller'Class;

   type Controller_Access_Array is array (Permission_Index range <>) of Controller_Access;

   --  Get the permission index associated with the name.
   function Get_Permission_Index (Name : in String) return Permission_Index;

   --  Get the last permission index registered in the global permission map.
   function Get_Last_Permission_Index return Permission_Index;

   --  Add the permission name and allocate a unique permission index.
   procedure Add_Permission (Name  : in String;
                             Index : out Permission_Index);

   --  The permission root class.
   type Abstract_Permission is abstract tagged limited null record;

   --  Each role is represented by a Role_Type number to provide a fast
   --  and efficient role check.
   type Role_Type is new Natural range 0 .. 63;

   type Role_Type_Array is array (Positive range <>) of Role_Type;

   --  The Role_Map represents a set of roles which are assigned to a user.
   --  Each role is represented by a boolean in the map.  The implementation is limited
   --  to 64 roles (the number of different permissions can be higher).
   type Role_Map is array (Role_Type'Range) of Boolean;
   pragma Pack (Role_Map);

   --  Each permission is represented by a Permission_Type number to provide a fast
   --  and efficient permission check.
   type Permission_Type is new Natural range 0 .. 63;

   --  The Permission_Map represents a set of permissions which are granted to a user.
   --  Each permission is represented by a boolean in the map.  The implementation is limited
   --  to 64 permissions.
   type Permission_Map is array (Permission_Type'Range) of Boolean;
   pragma Pack (Permission_Map);

   --  ------------------------------
   --  Principal
   --  ------------------------------
   type Principal is limited interface;
   type Principal_Access is access all Principal'Class;

   --  Returns true if the given role is stored in the user principal.
   function Has_Role (User : in Principal;
                      Role : in Role_Type) return Boolean is abstract;

   --  Get the principal name.
   function Get_Name (From : in Principal) return String is abstract;

   --  ------------------------------
   --  Permission
   --  ------------------------------

   --  Represents a permission for a given role.
   type Permission (Role : Permission_Type) is new Abstract_Permission with null record;

   --  ------------------------------
   --  URI Permission
   --  ------------------------------
   --  Represents a permission to access a given URI.
   type URI_Permission (Len : Natural) is new Abstract_Permission with record
      URI : String (1 .. Len);
   end record;

   --  ------------------------------
   --  File Permission
   --  ------------------------------

   type File_Mode is (READ, WRITE);

   --  Represents a permission to access a given file.
   type File_Permission (Len  : Natural;
                         Mode : File_Mode) is new Abstract_Permission with record
      Path : String (1 .. Len);
   end record;

   --  ------------------------------
   --  Permission Manager
   --  ------------------------------
   --  The Permission_Manager verifies through some policy that a permission
   --  is granted to a user.
   type Permission_Manager is new Ada.Finalization.Limited_Controlled with private;
   type Permission_Manager_Access is access all Permission_Manager'Class;

   procedure Add_Permission (Manager    : in out Permission_Manager;
                             Name       : in String;
                             Permission : in Controller_Access);

   --  Find the role type associated with the role name identified by Name.
   --  Raises Invalid_Name if there is no role type.
   function Find_Role (Manager : in Permission_Manager;
                       Name    : in String) return Role_Type;

   --  Returns True if the user has the permission to access the given URI permission.
   function Has_Permission (Manager    : in Permission_Manager;
                            Context    : in Security_Context_Access;
                            Permission : in URI_Permission'Class) return Boolean;

   --  Returns True if the user has the given role permission.
   function Has_Permission (Manager    : in Permission_Manager;
                            User       : in Principal'Class;
                            Permission : in Permission_Type) return Boolean;

   --  Get the security controller associated with the permission index Index.
   --  Returns null if there is no such controller.
   function Get_Controller (Manager : in Permission_Manager'Class;
                            Index   : in Permission_Index) return Controller_Access;
   pragma Inline_Always (Get_Controller);

   --  Get the role name.
   function Get_Role_Name (Manager : in Permission_Manager;
                           Role    : in Role_Type) return String;

   --  Create a role
   procedure Create_Role (Manager : in out Permission_Manager;
                          Name    : in String;
                          Role    : out Role_Type);

   --  Get or add a role type for the given name.
   procedure Add_Role_Type (Manager   : in out Permission_Manager;
                            Name      : in String;
                            Result    : out Role_Type);

   --  Grant the permission to access to the given URI to users having the To
   --  permissions.
   procedure Grant_URI_Permission (Manager : in out Permission_Manager;
                                   URI     : in String;
                                   To      : in String);

   --  Grant the permission to access to the given Path to users having the To
   --  permissions.
   procedure Grant_File_Permission (Manager : in out Permission_Manager;
                                    Path    : in String;
                                    To      : in String);

   --  Read the policy file
   procedure Read_Policy (Manager : in out Permission_Manager;
                          File    : in String);

   --  Initialize the permission manager.
   overriding
   procedure Initialize (Manager : in out Permission_Manager);

   --  Finalize the permission manager.
   overriding
   procedure Finalize (Manager : in out Permission_Manager);

   generic
      Name : String;
   package Permission_ACL is
      function Permission return Permission_Index;
      pragma Inline_Always (Permission);
   end Permission_ACL;

   --  ------------------------------
   --  Policy Configuration
   --  ------------------------------
   type Policy_Config is record
      Id          : Natural := 0;
      Permissions : Util.Beans.Objects.Vectors.Vector;
      Patterns    : Util.Beans.Objects.Vectors.Vector;
      Manager     : Permission_Manager_Access;
   end record;
   type Policy_Config_Access is access all Policy_Config;

   --  Setup the XML parser to read the policy description.  For example:
   --
   --  <policy id='1'>
   --     <permission>create-workspace</permission>
   --     <permission>admin</permission>
   --     <url-pattern>/workspace/create</url-pattern>
   --     <url-pattern>/workspace/setup/*</url-pattern>
   --  </policy>
   --
   --  This policy gives access to the URL that match one of the URL pattern if the
   --  security context has the permission create-workspace or admin.
   generic
      Reader  : in out Util.Serialize.IO.XML.Parser;
      Manager : in Security.Permissions.Permission_Manager_Access;
   package Reader_Config is
      Config : aliased Policy_Config;
   end Reader_Config;

   --  Register a set of functions in the namespace
   --  xmlns:fn="http://code.google.com/p/ada-asf/auth"
   --  Functions:
   --    hasPermission(NAME)   --  Returns True if the permission NAME is granted
   --  procedure Set_Functions (Mapper : in out EL.Functions.Function_Mapper'Class);

private

   use Util.Strings;

   type Role_Name_Array is
     array (Role_Type'Range) of Ada.Strings.Unbounded.String_Access;

   type Permission_Type_Array is array (1 .. 10) of Permission_Type;

   type Permission_Index_Array is array (Positive range <>) of Permission_Index;

   --  The Access_Rule represents a list of permissions to verify to grant
   --  access to the resource.  To make it simple, the user must have one of the
   --  permission from the list.  Each permission will refer to a specific permission
   --  controller.
   type Access_Rule (Count : Natural) is new Util.Refs.Ref_Entity with record
      Permissions : Permission_Index_Array (1 .. Count);
   end record;
   type Access_Rule_Access is access all Access_Rule;

   package Access_Rule_Refs is
     new Util.Refs.Indefinite_References (Element_Type   => Access_Rule,
                                          Element_Access => Access_Rule_Access);
   subtype Access_Rule_Ref is Access_Rule_Refs.Ref;

   --  No rule
--     No_Rule : constant Access_Rule := (Count => 0,
--                                        Permissions => (others => Permission_Index'First));

   --  Find the access rule of the policy that matches the given URI.
   --  Returns the No_Rule value (disable access) if no rule is found.
   function Find_Access_Rule (Manager : in Permission_Manager;
                              URI     : in String) return Access_Rule_Ref;

   --  The Policy defines the access rules that are applied on a given
   --  URL, set of URLs or files.
   type Policy is record
      Id      : Natural;
      Pattern : GNAT.Regexp.Regexp;
      Rule    : Access_Rule_Ref;
   end record;

   --  The Policy_Vector represents the whole permission policy.  The order of
   --  policy in the list is important as policies can override each other.
   package Policy_Vector is new Ada.Containers.Vectors (Index_Type   => Positive,
                                                        Element_Type => Policy);

   package Rules_Maps is new Ada.Containers.Hashed_Maps (Key_Type        => String_Ref,
                                                         Element_Type    => Access_Rule_Ref,
                                                         Hash            => Hash,
                                                         Equivalent_Keys => Equivalent_Keys,
                                                         "="             => Access_Rule_Refs."=");

   type Rules is new Util.Refs.Ref_Entity with record
      Map : Rules_Maps.Map;
   end record;
   type Rules_Access is access all Rules;

   package Rules_Ref is new Util.Refs.References (Rules, Rules_Access);

   type Rules_Ref_Access is access Rules_Ref.Atomic_Ref;

   type Controller_Access_Array_Access is access all Controller_Access_Array;

   type Permission_Manager is new Ada.Finalization.Limited_Controlled with record
      Names        : Role_Name_Array;
      Cache        : Rules_Ref_Access;
      Next_Role    : Role_Type := Role_Type'First;
      Policies     : Policy_Vector.Vector;
      Permissions  : Controller_Access_Array_Access;
      Last_Index   : Permission_Index := Permission_Index'First;
   end record;

   --  EL function to check if the given permission name is granted by the current
   --  security context.
   function Has_Permission (Value : in Util.Beans.Objects.Object)
                            return Util.Beans.Objects.Object;

end Security.Permissions;

Document the permission and principal

Document the permission and principal


-----------------------------------------------------------------------
--  mat-targets - Representation of target information
--  Copyright (C) 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.Strings.Unbounded;
with Ada.Containers.Ordered_Maps;

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

   type Target_Process_Type is tagged limited record
      Pid     : MAT.Types.Target_Process_Ref;
      Memory  : MAT.Memory.Targets.Target_Memory;
      Console : MAT.Consoles.Console_Access;
   end record;
   type Target_Process_Type_Access is access all Target_Process_Type'Class;

   type Target_Type is tagged limited record
      Pid     : MAT.Types.Target_Process_Ref;
      Memory  : MAT.Memory.Targets.Target_Memory;
      Symbols : MAT.Symbols.Targets.Target_Symbols;
      Console : MAT.Consoles.Console_Access;
   end record;

   type Target_Type_Access is access all Target_Type'Class;

   --  Initialize the target object to manage the memory slots, the stack frames
   --  and setup the reader to analyze the memory and other events.
   procedure Initialize (Target : in out Target_Type;
                         Reader : in out MAT.Readers.Manager_Base'Class);

   --  Create a process instance to hold and keep track of memory and other information about
   --  the given process ID.
   procedure Create_Process (Target  : in out Target_Type;
                             Pid     : in MAT.Types.Target_Process_Ref;
                             Process : out Target_Process_Type_Access);

private

   --  Define a map of <tt>Target_Process_Type_Access</tt> keyed by the process Id.
   --  This map allows to retrieve the information about a process.
   use type MAT.Types.Target_Process_Ref;
   package Process_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Process_Ref,
                                      Element_Type => Target_Process_Type_Access);

   subtype Process_Map is Process_Maps.Map;
   subtype Process_Cursor is Process_Maps.Cursor;

end MAT.Targets;

-----------------------------------------------------------------------
--  mat-targets - Representation of target information
--  Copyright (C) 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.Strings.Unbounded;
with Ada.Containers.Ordered_Maps;

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

   type Target_Process_Type is tagged limited record
      Pid     : MAT.Types.Target_Process_Ref;
      Memory  : MAT.Memory.Targets.Target_Memory;
      Console : MAT.Consoles.Console_Access;
   end record;
   type Target_Process_Type_Access is access all Target_Process_Type'Class;

   type Target_Type is tagged limited record
      Pid     : MAT.Types.Target_Process_Ref;
      Memory  : MAT.Memory.Targets.Target_Memory;
      Symbols : MAT.Symbols.Targets.Target_Symbols;
      Console : MAT.Consoles.Console_Access;
   end record;

   type Target_Type_Access is access all Target_Type'Class;

   --  Initialize the target object to manage the memory slots, the stack frames
   --  and setup the reader to analyze the memory and other events.
   procedure Initialize (Target : in out Target_Type;
                         Reader : in out MAT.Readers.Manager_Base'Class);

   --  Create a process instance to hold and keep track of memory and other information about
   --  the given process ID.
   procedure Create_Process (Target  : in out Target_Type;
                             Pid     : in MAT.Types.Target_Process_Ref;
                             Process : out Target_Process_Type_Access);

   --  Find the process instance from the process ID.
   function Find_Process (Target : in Target_Type;
                          Pid    : in MAT.Types.Target_Process_Ref)
                          return Target_Process_Type_Access;

private

   --  Define a map of <tt>Target_Process_Type_Access</tt> keyed by the process Id.
   --  This map allows to retrieve the information about a process.
   use type MAT.Types.Target_Process_Ref;
   package Process_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Process_Ref,
                                      Element_Type => Target_Process_Type_Access);

   subtype Process_Map is Process_Maps.Map;
   subtype Process_Cursor is Process_Maps.Cursor;

end MAT.Targets;

Declare the Find_Process function

Declare the Find_Process function


-----------------------------------------------------------------------
--  awa-tags -- Tags management
--  Copyright (C) 2013 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.
-----------------------------------------------------------------------

--  == Introduction ==
--  The <b>Tags</b> module allows to associate general purpose tags to any database entity.
--  It provides a JSF component that allows to insert easily a list of tags in a page and
--  in a form.  An application can use the bean types defined in <tt>AWA.Tags.Beans</tt>
--  to define the tags and it will use the <tt>awa:tagList</tt> component to display them.
--  A tag cloud is also provided by the <tt>awa:tagCloud</tt> component.
--
--  == Model ==
--  The database model is generic and it uses the <tt>Entity_Type</tt> provided by
--  [http://ada-ado.googlecode.com ADO] to associate a tag to entities stored in different
--  tables.  The <tt>Entity_Type</tt> identifies the database table and the stored identifier
--  in <tt>for_entity_id</tt> defines the entity in that table.
--
--  [http://ada-awa.googlecode.com/svn/wiki/awa_tags_model.png]
--
--  @include awa-tags-modules.ads
--  @include awa-tags-beans.ads
--  @include awa-tags-components.ads
--
package AWA.Tags is

   pragma Pure;

end AWA.Tags;

-----------------------------------------------------------------------
--  awa-tags -- Tags management
--  Copyright (C) 2013 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.
-----------------------------------------------------------------------

--  == Introduction ==
--  The <b>Tags</b> module allows to associate general purpose tags to any database entity.
--  It provides a JSF component that allows to insert easily a list of tags in a page and
--  in a form.  An application can use the bean types defined in <tt>AWA.Tags.Beans</tt>
--  to define the tags and it will use the <tt>awa:tagList</tt> component to display them.
--  A tag cloud is also provided by the <tt>awa:tagCloud</tt> component.
--
--  == Model ==
--  The database model is generic and it uses the <tt>Entity_Type</tt> provided by
--  [http://ada-ado.googlecode.com ADO] to associate a tag to entities stored in different
--  tables.  The <tt>Entity_Type</tt> identifies the database table and the stored identifier
--  in <tt>for_entity_id</tt> defines the entity in that table.
--
--  [http://ada-awa.googlecode.com/svn/wiki/awa_tags_model.png]
--
--  @include awa-tags-modules.ads
--  @include awa-tags-beans.ads
--  @include awa-tags-components.ads
--
--  == Queries ==
--  @include tag-queries.xml
package AWA.Tags is

   pragma Pure;

end AWA.Tags;

Update the documentation

Update the documentation


-----------------------------------------------------------------------
--  ASF tests - ASF Tests Framework
--  Copyright (C) 2011, 2012, 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 Util.Properties;
with ASF.Requests.Mockup;
with ASF.Responses.Mockup;
with ASF.Server;
with ASF.Applications.Main;
with Servlet.Tests;
with Util.Tests;
with Util.XUnit;

with EL.Contexts.Default;
with EL.Variables;

with GNAT.Source_Info;

--  The <b>ASF.Tests</b> package provides a set of utility procedures to write a unit test
--  on top of ASF.
package ASF.Tests is

   --  Initialize the asf test framework mockup.  If the application is not specified,
   --  a default ASF application is created.
   procedure Initialize (Props       : in Util.Properties.Manager;
                         Application : in ASF.Applications.Main.Application_Access := null;
                         Factory     : in out ASF.Applications.Main.Application_Factory'Class);

   --  Called when the testsuite execution has finished.
   procedure Finish (Status : in Util.XUnit.Status) renames Servlet.Tests.Finish;

   --  Get the server
   function Get_Server return access ASF.Server.Container renames Servlet.Tests.Get_Server;

   --  Get the test application.
   function Get_Application return ASF.Applications.Main.Application_Access;

   --  Simulate a GET request on the given URI with the request parameters.
   --  Get the result in the response object.
   procedure Do_Get (Request  : in out ASF.Requests.Mockup.Request;
                     Response : in out ASF.Responses.Mockup.Response;
                     URI      : in String;
                     Save     : in String := "") renames Servlet.Tests.Do_Get;

   --  Simulate a POST request on the given URI with the request parameters.
   --  Get the result in the response object.
   procedure Do_Post (Request  : in out ASF.Requests.Mockup.Request;
                      Response : in out ASF.Responses.Mockup.Response;
                      URI      : in String;
                      Save     : in String := "") renames Servlet.Tests.Do_Post;

   --  Simulate a raw request.  The URI and method must have been set on the Request object.
   procedure Do_Req (Request  : in out ASF.Requests.Mockup.Request;
                     Response : in out ASF.Responses.Mockup.Response)
                     renames Servlet.Tests.Do_Req;

   --  Check that the response body contains the string
   procedure Assert_Contains (T       : in Util.Tests.Test'Class;
                              Value   : in String;
                              Reply   : in out ASF.Responses.Mockup.Response;
                              Message : in String := "Test failed";
                              Source  : String := GNAT.Source_Info.File;
                              Line    : Natural := GNAT.Source_Info.Line)
                              renames Servlet.Tests.Assert_Contains;

   --  Check that the response body matches the regular expression
   procedure Assert_Matches (T       : in Util.Tests.Test'Class;
                             Pattern : in String;
                             Reply   : in out ASF.Responses.Mockup.Response;
                             Message : in String := "Test failed";
                             Status  : in Natural := ASF.Responses.SC_OK;
                             Source  : String := GNAT.Source_Info.File;
                             Line    : Natural := GNAT.Source_Info.Line)
                             renames Servlet.Tests.Assert_Matches;

   --  Check that the response body is a redirect to the given URI.
   procedure Assert_Redirect (T       : in Util.Tests.Test'Class;
                              Value   : in String;
                              Reply   : in out ASF.Responses.Mockup.Response;
                              Message : in String := "Test failed";
                              Source  : String := GNAT.Source_Info.File;
                              Line    : Natural := GNAT.Source_Info.Line)
                              renames Servlet.Tests.Assert_Redirect;

   --  Check that the response contains the given header.
   procedure Assert_Header (T       : in Util.Tests.Test'Class;
                            Header  : in String;
                            Value   : in String;
                            Reply   : in out ASF.Responses.Mockup.Response;
                            Message : in String := "Test failed";
                            Status  : in Natural := ASF.Responses.SC_OK;
                            Source  : String := GNAT.Source_Info.File;
                            Line    : Natural := GNAT.Source_Info.Line)
                            renames Servlet.Tests.Assert_Header;

   type EL_Test is new Util.Tests.Test with record
      --  The ELContext, Variables, Resolver, Form area controlled object.
      --  Due to AUnit implementation, we cannot store a controlled object in the Test object.
      --  This is due to the 'for Obj'Address use Ret;' clause used by AUnit to allocate
      --  a test object.
      --  The application object is allocated dyanmically by Set_Up.
      ELContext      : EL.Contexts.Default.Default_Context_Access;
      Variables      : EL.Variables.Variable_Mapper_Access;
      Root_Resolver  : EL.Contexts.Default.Default_ELResolver_Access;
   end record;

   --  Cleanup the test instance.
   overriding
   procedure Tear_Down (T : in out EL_Test);

   --  Setup the test instance.
   overriding
   procedure Set_Up (T : in out EL_Test);

end ASF.Tests;

-----------------------------------------------------------------------
--  ASF tests - ASF Tests Framework
--  Copyright (C) 2011, 2012, 2015, 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 Util.Properties;
with ASF.Requests.Mockup;
with ASF.Responses.Mockup;
with ASF.Server;
with ASF.Applications.Main;
with Servlet.Tests;
with Util.Tests;
with Util.XUnit;

with EL.Contexts.Default;
with EL.Variables;

with GNAT.Source_Info;

--  The <b>ASF.Tests</b> package provides a set of utility procedures to write a unit test
--  on top of ASF.
package ASF.Tests is

   --  Initialize the asf test framework mockup.  If the application is not specified,
   --  a default ASF application is created.
   procedure Initialize (Props       : in Util.Properties.Manager;
                         Application : in ASF.Applications.Main.Application_Access := null;
                         Factory     : in out ASF.Applications.Main.Application_Factory'Class);

   --  Called when the testsuite execution has finished.
   procedure Finish (Status : in Util.XUnit.Status) renames Servlet.Tests.Finish;

   --  Get the server
   function Get_Server return access ASF.Server.Container renames Servlet.Tests.Get_Server;

   --  Get the test application.
   function Get_Application return ASF.Applications.Main.Application_Access;

   --  Simulate a GET request on the given URI with the request parameters.
   --  Get the result in the response object.
   procedure Do_Get (Request  : in out ASF.Requests.Mockup.Request;
                     Response : in out ASF.Responses.Mockup.Response;
                     URI      : in String;
                     Save     : in String := "") renames Servlet.Tests.Do_Get;

   --  Simulate a POST request on the given URI with the request parameters.
   --  Get the result in the response object.
   procedure Do_Post (Request  : in out ASF.Requests.Mockup.Request'Class;
                      Response : in out ASF.Responses.Mockup.Response'Class;
                      URI      : in String;
                      Save     : in String := "") renames Servlet.Tests.Do_Post;

   --  Simulate a raw request.  The URI and method must have been set on the Request object.
   procedure Do_Req (Request  : in out ASF.Requests.Mockup.Request'Class;
                     Response : in out ASF.Responses.Mockup.Response'Class)
                     renames Servlet.Tests.Do_Req;

   --  Check that the response body contains the string
   procedure Assert_Contains (T       : in Util.Tests.Test'Class;
                              Value   : in String;
                              Reply   : in out ASF.Responses.Mockup.Response;
                              Message : in String := "Test failed";
                              Source  : String := GNAT.Source_Info.File;
                              Line    : Natural := GNAT.Source_Info.Line)
                              renames Servlet.Tests.Assert_Contains;

   --  Check that the response body matches the regular expression
   procedure Assert_Matches (T       : in Util.Tests.Test'Class;
                             Pattern : in String;
                             Reply   : in out ASF.Responses.Mockup.Response;
                             Message : in String := "Test failed";
                             Status  : in Natural := ASF.Responses.SC_OK;
                             Source  : String := GNAT.Source_Info.File;
                             Line    : Natural := GNAT.Source_Info.Line)
                             renames Servlet.Tests.Assert_Matches;

   --  Check that the response body is a redirect to the given URI.
   procedure Assert_Redirect (T       : in Util.Tests.Test'Class;
                              Value   : in String;
                              Reply   : in out ASF.Responses.Mockup.Response;
                              Message : in String := "Test failed";
                              Source  : String := GNAT.Source_Info.File;
                              Line    : Natural := GNAT.Source_Info.Line)
                              renames Servlet.Tests.Assert_Redirect;

   --  Check that the response contains the given header.
   procedure Assert_Header (T       : in Util.Tests.Test'Class;
                            Header  : in String;
                            Value   : in String;
                            Reply   : in out ASF.Responses.Mockup.Response;
                            Message : in String := "Test failed";
                            Status  : in Natural := ASF.Responses.SC_OK;
                            Source  : String := GNAT.Source_Info.File;
                            Line    : Natural := GNAT.Source_Info.Line)
                            renames Servlet.Tests.Assert_Header;

   type EL_Test is new Util.Tests.Test with record
      --  The ELContext, Variables, Resolver, Form area controlled object.
      --  Due to AUnit implementation, we cannot store a controlled object in the Test object.
      --  This is due to the 'for Obj'Address use Ret;' clause used by AUnit to allocate
      --  a test object.
      --  The application object is allocated dyanmically by Set_Up.
      ELContext      : EL.Contexts.Default.Default_Context_Access;
      Variables      : EL.Variables.Variable_Mapper_Access;
      Root_Resolver  : EL.Contexts.Default.Default_ELResolver_Access;
   end record;

   --  Cleanup the test instance.
   overriding
   procedure Tear_Down (T : in out EL_Test);

   --  Setup the test instance.
   overriding
   procedure Set_Up (T : in out EL_Test);

end ASF.Tests;

Update Do_Req and Do_Post definitions

Update Do_Req and Do_Post definitions


-----------------------------------------------------------------------
--  druss-commands-bboxes -- Commands to manage the bboxes
--  Copyright (C) 2017 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.
-----------------------------------------------------------------------

package Druss.Commands.Bboxes is

   type Command_Type is new Druss.Commands.Drivers.Command_Type with null record;

   procedure Discover (Command   : in Command_Type;
                       Context   : in out Context_Type);

   --  Add the bbox with the given IP address.
   procedure Add_Bbox (Command : in Command_Type;
                       IP      : in String;
                       Context : in out Context_Type);

   --  Execute the command with the arguments.  The command name is passed with the command
   --  arguments.
   overriding
   procedure Execute (Command   : in Command_Type;
                      Name      : in String;
                      Args      : in Druss.Commands.Argument_List'Class;
                      Context   : in out Context_Type);

   --  Write the help associated with the command.
   overriding
   procedure Help (Command   : in Command_Type;
                   Context   : in out Context_Type);

end Druss.Commands.Bboxes;

-----------------------------------------------------------------------
--  druss-commands-bboxes -- Commands to manage the bboxes
--  Copyright (C) 2017 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.
-----------------------------------------------------------------------

package Druss.Commands.Bboxes is

   type Command_Type is new Druss.Commands.Drivers.Command_Type with null record;

   procedure Discover (Command   : in Command_Type;
                       Context   : in out Context_Type);

   --  Add the bbox with the given IP address.
   procedure Add_Bbox (Command : in Command_Type;
                       IP      : in String;
                       Context : in out Context_Type);

   --  Enable or disable the bbox management by Druss.
   procedure Do_Enable (Command   : in Command_Type;
                        Args      : in Util.Commands.Argument_List'Class;
                        State     : in Boolean;
                        Context   : in out Context_Type);

   --  Execute the command with the arguments.  The command name is passed with the command
   --  arguments.
   overriding
   procedure Execute (Command   : in Command_Type;
                      Name      : in String;
                      Args      : in Druss.Commands.Argument_List'Class;
                      Context   : in out Context_Type);

   --  Write the help associated with the command.
   overriding
   procedure Help (Command   : in Command_Type;
                   Context   : in out Context_Type);

end Druss.Commands.Bboxes;

Declare the Do_Enable procedure

Declare the Do_Enable procedure


-----------------------------------------------------------------------
--  ADO Databases -- Database Objects
--  Copyright (C) 2009, 2010, 2013 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 ADO.Testsuite;
with ADO.Drivers.Initializer;
with Regtests;

with Util.Tests;
with Util.Properties;
procedure ADO_Harness is

   procedure Initialize (Props : in Util.Properties.Manager);

   procedure Harness is new Util.Tests.Harness (ADO.Testsuite.Suite,
                                               Initialize);

   procedure Init_Drivers is new ADO.Drivers.Initializer (Util.Properties.Manager'Class,
                                                          ADO.Drivers.Initialize);

   --  ------------------------------
   --  Initialization procedure: setup the database
   --  ------------------------------
   procedure Initialize (Props : in Util.Properties.Manager) is
      DB : constant String := Props.Get ("test.database",
                                         "sqlite:///regtests.db");
   begin
      Init_Drivers (Props);
      Regtests.Initialize (DB);
   end Initialize;

begin
   Harness ("ado-tests.xml");
end ADO_Harness;

-----------------------------------------------------------------------
--  ADO Databases -- Database Objects
--  Copyright (C) 2009, 2010, 2013 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 ADO.Testsuite;
with ADO.Drivers;
with Regtests;

with Util.Tests;
with Util.Properties;
procedure ADO_Harness is

   procedure Initialize (Props : in Util.Properties.Manager);

   procedure Harness is new Util.Tests.Harness (ADO.Testsuite.Suite,
                                               Initialize);

   --  ------------------------------
   --  Initialization procedure: setup the database
   --  ------------------------------
   procedure Initialize (Props : in Util.Properties.Manager) is
      DB : constant String := Props.Get ("test.database",
                                         "sqlite:///regtests.db");
   begin
      ADO.Drivers.Initialize (Props);
      Regtests.Initialize (DB);
   end Initialize;

begin
   Harness ("ado-tests.xml");
end ADO_Harness;

Fix the initialization of the database drivers


-----------------------------------------------------------------------
--  mat-events-targets - Events received and collected from a target
--  Copyright (C) 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.
-----------------------------------------------------------------------

package body MAT.Events.Targets is

   --  ------------------------------
   --  Add the event in the list of events and increment the event counter.
   --  ------------------------------
   procedure Insert (Target : in out Target_Events;
                     Event  : in Probe_Event_Type) is
   begin
      Target.Events.Insert (Event);
      Util.Concurrent.Counters.Increment (Target.Event_Count);
   end Insert;

   procedure Get_Events (Target : in out Target_Events;
                         Start  : in MAT.Types.Target_Time;
                         Finish : in MAT.Types.Target_Time;
                         Into   : in out Target_Event_Vector) is
   begin
      Target.Events.Get_Events (Start, Finish, Into);
   end Get_Events;

   --  ------------------------------
   --  Get the start and finish time for the events that have been received.
   --  ------------------------------
   procedure Get_Time_Range (Target : in out Target_Events;
                             Start  : out MAT.Types.Target_Time;
                             Finish : out MAT.Types.Target_Time) is
   begin
      Target.Events.Get_Time_Range (Start, Finish);
   end Get_Time_Range;

   --  ------------------------------
   --  Get the current event counter.
   --  ------------------------------
   function Get_Event_Counter (Target : in Target_Events) return Integer is
   begin
      return Util.Concurrent.Counters.Value (Target.Event_Count);
   end Get_Event_Counter;

   protected body Event_Collector is

      --  ------------------------------
      --  Add the event in the list of events.
      --  ------------------------------
      procedure Insert (Event : in Probe_Event_Type) is
         Info : Target_Event;
      begin
         if Current = null then
            Current := new Event_Block;
            Current.Start := Event.Time;
            Events.Insert (Event.Time, Current);
         end if;
         Current.Count := Current.Count + 1;
         Current.Events (Current.Count) := Event;
         Current.Events (Current.Count).Id := Last_Id;
         Last_Id := Last_Id + 1;
         Current.Finish := Event.Time;
         if Current.Count = Current.Events'Last then
            Current := null;
         end if;
      end Insert;

      procedure Get_Events (Start  : in MAT.Types.Target_Time;
                            Finish : in MAT.Types.Target_Time;
                            Into   : in out Target_Event_Vector) is
         Iter  : Event_Cursor := Events.Floor (Start);
         Block : Event_Block_Access;
      begin
         while Event_Maps.Has_Element (Iter) loop
            Block := Event_Maps.Element (Iter);
            exit when Block.Start > Finish;
            for I in Block.Events'First .. Block.Count loop
               exit when Block.Events (I).Time > Finish;
               if Block.Events (I).Time >= Start then
                  Into.Append (Block.Events (I));
               end if;
            end loop;
            Event_Maps.Next (Iter);
         end loop;
      end Get_Events;

      --  ------------------------------
      --  Get the start and finish time for the events that have been received.
      --  ------------------------------
      procedure Get_Time_Range (Start  : out MAT.Types.Target_Time;
                                Finish : out MAT.Types.Target_Time) is
         First : constant Event_Block_Access := Events.First_Element;
         Last  : constant Event_Block_Access := Events.Last_Element;
      begin
         Start  := First.Events (First.Events'First).Time;
         Finish := Last.Events (Last.Count).Time;
      end Get_Time_Range;

   end Event_Collector;

end MAT.Events.Targets;

-----------------------------------------------------------------------
--  mat-events-targets - Events received and collected from a target
--  Copyright (C) 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.
-----------------------------------------------------------------------

package body MAT.Events.Targets is

   --  ------------------------------
   --  Add the event in the list of events and increment the event counter.
   --  ------------------------------
   procedure Insert (Target : in out Target_Events;
                     Event  : in Probe_Event_Type) is
   begin
      Target.Events.Insert (Event);
      Util.Concurrent.Counters.Increment (Target.Event_Count);
   end Insert;

   procedure Get_Events (Target : in out Target_Events;
                         Start  : in MAT.Types.Target_Time;
                         Finish : in MAT.Types.Target_Time;
                         Into   : in out Target_Event_Vector) is
   begin
      Target.Events.Get_Events (Start, Finish, Into);
   end Get_Events;

   --  ------------------------------
   --  Get the start and finish time for the events that have been received.
   --  ------------------------------
   procedure Get_Time_Range (Target : in out Target_Events;
                             Start  : out MAT.Types.Target_Time;
                             Finish : out MAT.Types.Target_Time) is
   begin
      Target.Events.Get_Time_Range (Start, Finish);
   end Get_Time_Range;

   --  ------------------------------
   --  Get the current event counter.
   --  ------------------------------
   function Get_Event_Counter (Target : in Target_Events) return Integer is
   begin
      return Util.Concurrent.Counters.Value (Target.Event_Count);
   end Get_Event_Counter;

   protected body Event_Collector is

      --  ------------------------------
      --  Add the event in the list of events.
      --  ------------------------------
      procedure Insert (Event : in Probe_Event_Type) is
         Info : Target_Event;
      begin
         if Current = null then
            Current := new Event_Block;
            Current.Start := Event.Time;
            Events.Insert (Event.Time, Current);
            Ids.Insert (Last_Id + 1, Current);
         end if;
         Current.Count := Current.Count + 1;
         Current.Events (Current.Count) := Event;
         Current.Events (Current.Count).Id := Last_Id;
         Last_Id := Last_Id + 1;
         Current.Finish := Event.Time;
         if Current.Count = Current.Events'Last then
            Current := null;
         end if;
      end Insert;

      procedure Get_Events (Start  : in MAT.Types.Target_Time;
                            Finish : in MAT.Types.Target_Time;
                            Into   : in out Target_Event_Vector) is
         Iter  : Event_Cursor := Events.Floor (Start);
         Block : Event_Block_Access;
      begin
         while Event_Maps.Has_Element (Iter) loop
            Block := Event_Maps.Element (Iter);
            exit when Block.Start > Finish;
            for I in Block.Events'First .. Block.Count loop
               exit when Block.Events (I).Time > Finish;
               if Block.Events (I).Time >= Start then
                  Into.Append (Block.Events (I));
               end if;
            end loop;
            Event_Maps.Next (Iter);
         end loop;
      end Get_Events;

      --  ------------------------------
      --  Get the start and finish time for the events that have been received.
      --  ------------------------------
      procedure Get_Time_Range (Start  : out MAT.Types.Target_Time;
                                Finish : out MAT.Types.Target_Time) is
         First : constant Event_Block_Access := Events.First_Element;
         Last  : constant Event_Block_Access := Events.Last_Element;
      begin
         Start  := First.Events (First.Events'First).Time;
         Finish := Last.Events (Last.Count).Time;
      end Get_Time_Range;

      --  ------------------------------
      --  Get the probe event with the given allocated unique id.
      --  ------------------------------
      function Get_Event (Id : in Event_Id_Type) return Probe_Event_Type is
         Iter  : Event_Id_Cursor := Ids.Floor (Id);
         Block : Event_Block_Access;
         Pos   : Event_Id_Type;
      begin
         while not Event_Id_Maps.Has_Element (Iter) loop
            Block := Event_Id_Maps.Element (Iter);
            exit when Id < Block.Events (Block.Events'First).Id;
            Pos := Id - Block.Events (Block.Events'First).Id;
            if Pos < Block.Count then
               return Block.Events (Pos);
            end if;
            Event_Id_Maps.Next (Iter);
         end loop;
         raise Not_Found;
      end Get_Event;

   end Event_Collector;

end MAT.Events.Targets;

Implement the Get_Event protected operation


-----------------------------------------------------------------------
--  awa-storages-services-tests -- Unit tests for storage service
--  Copyright (C) 2012, 2016, 2019 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.Streams;
with Ada.Strings.Unbounded;

with Util.Test_Caller;

with ADO;
with ADO.Objects;

with Security.Contexts;

with AWA.Services.Contexts;
with AWA.Storages.Modules;
with AWA.Storages.Beans.Factories;
with AWA.Tests.Helpers.Users;
package body AWA.Storages.Services.Tests is

   use ADO;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Storages.Services.Save (DATABASE)",
                       Test_Create_Storage'Access);
      Caller.Add_Test (Suite, "Test AWA.Storages.Services.Save (FILE)",
                       Test_File_Create_Storage'Access);
      Caller.Add_Test (Suite, "Test AWA.Storages.Services.Delete",
                       Test_Delete_Storage'Access);
      Caller.Add_Test (Suite, "Test AWA.Storages.Services.Save_Folder, Folder_Bean",
                       Test_Create_Folder'Access);
      Caller.Add_Test (Suite, "Test AWA.Storages.Services.Get_Local_File",
                       Test_Get_Local_File'Access);

   end Add_Tests;

   --  ------------------------------
   --  Save something in a storage element and keep track of the store id in the test Id.
   --  ------------------------------
   procedure Save (T : in out Test) is
      Store     : AWA.Storages.Models.Storage_Ref;
   begin
      T.Manager := AWA.Storages.Modules.Get_Storage_Manager;
      T.Assert (T.Manager /= null, "Null storage manager");

      Store.Set_Mime_Type ("text/plain");
      Store.Set_Name ("Makefile");
      Store.Set_File_Size (1000);
      T.Manager.Save (Into    => Store,
                      Path    => "Makefile",
                      Storage => T.Kind);
      T.Assert (not Store.Is_Null, "Storage object should not be null");
      T.Id := Store.Get_Id;
      T.Assert (T.Id > 0, "Invalid storage identifier");
   end Save;

   --  ------------------------------
   --  Load the storage element refered to by the test Id.
   --  ------------------------------
   procedure Load (T : in out Test) is
      use type Ada.Streams.Stream_Element_Offset;

      Name      : Ada.Strings.Unbounded.Unbounded_String;
      Mime      : Ada.Strings.Unbounded.Unbounded_String;
      Date      : Ada.Calendar.Time;
      Data      : ADO.Blob_Ref;
   begin
      T.Manager := AWA.Storages.Modules.Get_Storage_Manager;
      T.Assert (T.Manager /= null, "Null storage manager");

      T.Manager.Load (From => T.Id, Name => Name, Mime => Mime, Date => Date, Into => Data);
      T.Assert (not Data.Is_Null, "Null blob returned by load");
      T.Assert (Data.Value.Len > 100, "Invalid length for the blob data");
   end Load;

   --  ------------------------------
   --  Test creation of a storage object
   --  ------------------------------
   procedure Test_Create_Storage (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-storage@test.com");

      T.Save;
      T.Load;
   end Test_Create_Storage;

   procedure Test_File_Create_Storage (T : in out Test) is
   begin
      T.Kind := AWA.Storages.Models.FILE;
      T.Test_Create_Storage;
   end Test_File_Create_Storage;

   --  ------------------------------
   --  Test creation of a storage object and local file access after its creation.
   --  ------------------------------
   procedure Test_Get_Local_File (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-storage@test.com");

      T.Save;
      declare
         File : AWA.Storages.Storage_File (AWA.Storages.TMP);
      begin
         T.Manager.Get_Local_File (From => T.Id, Into => File);
         T.Assert (AWA.Storages.Get_Path (File)'Length > 0, "Invalid local file path");
      end;
   end Test_Get_Local_File;

   --  ------------------------------
   --  Test deletion of a storage object
   --  ------------------------------
   procedure Test_Delete_Storage (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
      Data      : ADO.Blob_Ref;
      Name      : Ada.Strings.Unbounded.Unbounded_String;
      Mime      : Ada.Strings.Unbounded.Unbounded_String;
      Date      : Ada.Calendar.Time;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-storage@test.com");

      T.Save;
      T.Manager.Delete (T.Id);
      begin
         T.Manager.Load (From => T.Id, Name => Name, Mime => Mime, Date => Date, Into => Data);
         T.Assert (False, "No exception raised");

      exception
         when ADO.Objects.NOT_FOUND =>
            null;
      end;
   end Test_Delete_Storage;

   --  ------------------------------
   --  Test creation of a storage folder
   --  ------------------------------
   procedure Test_Create_Folder (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
      Folder    : AWA.Storages.Beans.Factories.Folder_Bean;
      Outcome   : Ada.Strings.Unbounded.Unbounded_String;
      Upload    : AWA.Storages.Beans.Factories.Upload_Bean;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-storage@test.com");
      Folder.Module := AWA.Storages.Modules.Get_Storage_Module;
      Upload.Module := AWA.Storages.Modules.Get_Storage_Module;

      Folder.Set_Name ("Test folder name");
      Folder.Save (Outcome);
      Util.Tests.Assert_Equals (T, "success", Outcome, "Invalid outcome returned by Save action");

      Upload.Set_Value ("folderId", ADO.Objects.To_Object (Folder.Get_Key));
      Util.Tests.Assert_Equals (T, "Test folder name", String '(Upload.Get_Folder.Get_Name),
                                "Invalid folder name");
   end Test_Create_Folder;

end AWA.Storages.Services.Tests;

-----------------------------------------------------------------------
--  awa-storages-services-tests -- Unit tests for storage service
--  Copyright (C) 2012, 2016, 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 Ada.Streams;
with Ada.Strings.Unbounded;

with Util.Test_Caller;

with ADO;
with ADO.Objects;

with Security.Contexts;

with AWA.Services.Contexts;
with AWA.Storages.Modules;
with AWA.Storages.Beans;
with AWA.Tests.Helpers.Users;
package body AWA.Storages.Services.Tests is

   use ADO;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Storages.Services.Save (DATABASE)",
                       Test_Create_Storage'Access);
      Caller.Add_Test (Suite, "Test AWA.Storages.Services.Save (FILE)",
                       Test_File_Create_Storage'Access);
      Caller.Add_Test (Suite, "Test AWA.Storages.Services.Delete",
                       Test_Delete_Storage'Access);
      Caller.Add_Test (Suite, "Test AWA.Storages.Services.Save_Folder, Folder_Bean",
                       Test_Create_Folder'Access);
      Caller.Add_Test (Suite, "Test AWA.Storages.Services.Get_Local_File",
                       Test_Get_Local_File'Access);

   end Add_Tests;

   --  ------------------------------
   --  Save something in a storage element and keep track of the store id in the test Id.
   --  ------------------------------
   procedure Save (T : in out Test) is
      Store     : AWA.Storages.Models.Storage_Ref;
   begin
      T.Manager := AWA.Storages.Modules.Get_Storage_Manager;
      T.Assert (T.Manager /= null, "Null storage manager");

      Store.Set_Mime_Type ("text/plain");
      Store.Set_Name ("Makefile");
      Store.Set_File_Size (1000);
      T.Manager.Save (Into    => Store,
                      Path    => "Makefile",
                      Storage => T.Kind);
      T.Assert (not Store.Is_Null, "Storage object should not be null");
      T.Id := Store.Get_Id;
      T.Assert (T.Id > 0, "Invalid storage identifier");
   end Save;

   --  ------------------------------
   --  Load the storage element refered to by the test Id.
   --  ------------------------------
   procedure Load (T : in out Test) is
      use type Ada.Streams.Stream_Element_Offset;

      Name      : Ada.Strings.Unbounded.Unbounded_String;
      Mime      : Ada.Strings.Unbounded.Unbounded_String;
      Date      : Ada.Calendar.Time;
      Data      : ADO.Blob_Ref;
   begin
      T.Manager := AWA.Storages.Modules.Get_Storage_Manager;
      T.Assert (T.Manager /= null, "Null storage manager");

      T.Manager.Load (From => T.Id, Name => Name, Mime => Mime, Date => Date, Into => Data);
      T.Assert (not Data.Is_Null, "Null blob returned by load");
      T.Assert (Data.Value.Len > 100, "Invalid length for the blob data");
   end Load;

   --  ------------------------------
   --  Test creation of a storage object
   --  ------------------------------
   procedure Test_Create_Storage (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-storage@test.com");

      T.Save;
      T.Load;
   end Test_Create_Storage;

   procedure Test_File_Create_Storage (T : in out Test) is
   begin
      T.Kind := AWA.Storages.Models.FILE;
      T.Test_Create_Storage;
   end Test_File_Create_Storage;

   --  ------------------------------
   --  Test creation of a storage object and local file access after its creation.
   --  ------------------------------
   procedure Test_Get_Local_File (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-storage@test.com");

      T.Save;
      declare
         File : AWA.Storages.Storage_File (AWA.Storages.TMP);
      begin
         T.Manager.Get_Local_File (From => T.Id, Into => File);
         T.Assert (AWA.Storages.Get_Path (File)'Length > 0, "Invalid local file path");
      end;
   end Test_Get_Local_File;

   --  ------------------------------
   --  Test deletion of a storage object
   --  ------------------------------
   procedure Test_Delete_Storage (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
      Data      : ADO.Blob_Ref;
      Name      : Ada.Strings.Unbounded.Unbounded_String;
      Mime      : Ada.Strings.Unbounded.Unbounded_String;
      Date      : Ada.Calendar.Time;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-storage@test.com");

      T.Save;
      T.Manager.Delete (T.Id);
      begin
         T.Manager.Load (From => T.Id, Name => Name, Mime => Mime, Date => Date, Into => Data);
         T.Assert (False, "No exception raised");

      exception
         when ADO.Objects.NOT_FOUND =>
            null;
      end;
   end Test_Delete_Storage;

   --  ------------------------------
   --  Test creation of a storage folder
   --  ------------------------------
   procedure Test_Create_Folder (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
      Folder    : AWA.Storages.Beans.Folder_Bean;
      Outcome   : Ada.Strings.Unbounded.Unbounded_String;
      Upload    : AWA.Storages.Beans.Upload_Bean;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-storage@test.com");
      Folder.Module := AWA.Storages.Modules.Get_Storage_Module;
      Upload.Module := AWA.Storages.Modules.Get_Storage_Module;

      Folder.Set_Name ("Test folder name");
      Folder.Save (Outcome);
      Util.Tests.Assert_Equals (T, "success", Outcome, "Invalid outcome returned by Save action");

      Upload.Set_Value ("folderId", ADO.Objects.To_Object (Folder.Get_Key));
      Util.Tests.Assert_Equals (T, "Test folder name", String '(Upload.Get_Folder.Get_Name),
                                "Invalid folder name");
   end Test_Create_Folder;

end AWA.Storages.Services.Tests;

Update the test to avoir using the Beans.Factories package


-----------------------------------------------------------------------
--  streams.files.tests -- Unit tests for buffered streams
--  Copyright (C) 2012, 2018, 2019, 2021 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.Streams.Stream_IO;

with Util.Test_Caller;

with Util.Streams.Files;
with Util.Streams.Texts;
package body Util.Streams.Texts.Tests is

   use Ada.Streams.Stream_IO;
   use Util.Tests;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Streams.Texts.Open, Read_Line, Close",
                       Test_Read_Line'Access);
      Caller.Add_Test (Suite, "Test Util.Streams.Texts.Write (Integer)",
                       Test_Write_Integer'Access);
      Caller.Add_Test (Suite, "Test Util.Streams.Texts.Write (Long_Long_Integer)",
                       Test_Write_Long_Integer'Access);
      Caller.Add_Test (Suite, "Test Util.Streams.Texts.Write (Unbounded_String)",
                       Test_Write'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test reading a text stream.
   --  ------------------------------
   procedure Test_Read_Line (T : in out Test) is
      Stream : aliased Files.File_Stream;
      Reader : Util.Streams.Texts.Reader_Stream;
      Count  : Natural := 0;
   begin
      Stream.Open (Name => "Makefile", Mode => In_File);
      Reader.Initialize (From => Stream'Access);

      while not Reader.Is_Eof loop
         declare
            Line : Ada.Strings.Unbounded.Unbounded_String;
         begin
            Reader.Read_Line (Line);
            Count := Count + 1;
         end;
      end loop;
      Stream.Close;
      T.Assert (Count > 100, "Too few lines read");
   end Test_Read_Line;

   --  ------------------------------
   --  Write on a text stream converting an integer and writing it.
   --  ------------------------------
   procedure Test_Write_Integer (T : in out Test) is
      Stream  : Print_Stream;
      Buf     : Ada.Strings.Unbounded.Unbounded_String;
   begin
      Stream.Initialize (Size => 4);

      --  Write '0' (we don't want the Ada spurious space).
      Stream.Write (Integer (0));

      Assert_Equals (T, 1, Integer (Stream.Get_Size), "Invalid size for stream");

      Stream.Flush (Buf);
      Assert_Equals (T, 1, Ada.Strings.Unbounded.Length (Buf), "Invalid size for string");

      Assert_Equals (T, "0", Ada.Strings.Unbounded.To_String (Buf), "Invalid stream content");

      Assert_Equals (T, 0, Integer (Stream.Get_Size), "Invalid size for stream after Flush");

      --  Write '1234'
      Stream.Write (Integer (1234));

      Assert_Equals (T, 4, Integer (Stream.Get_Size), "Invalid size for stream");

      Stream.Flush (Buf);
      Assert_Equals (T, 4, Ada.Strings.Unbounded.Length (Buf), "Invalid size for string");

      Assert_Equals (T, "1234", Ada.Strings.Unbounded.To_String (Buf), "Invalid stream content");

      Assert_Equals (T, 0, Integer (Stream.Get_Size), "Invalid size for stream after Flush");

      --  Write '-234'
      Stream.Write (Integer (-234));

      Assert_Equals (T, 4, Integer (Stream.Get_Size), "Invalid size for stream");

      Stream.Flush (Buf);
      Assert_Equals (T, 4, Ada.Strings.Unbounded.Length (Buf), "Invalid size for string");

      Assert_Equals (T, "-234", Ada.Strings.Unbounded.To_String (Buf), "Invalid stream content");

      Assert_Equals (T, 0, Integer (Stream.Get_Size), "Invalid size for stream after Flush");
   end Test_Write_Integer;

   --  ------------------------------
   --  Write on a text stream converting an integer and writing it.
   --  ------------------------------
   procedure Test_Write_Long_Integer (T : in out Test) is
      Stream  : Print_Stream;
      Buf     : Ada.Strings.Unbounded.Unbounded_String;
   begin
      Stream.Initialize (Size => 64);

      --  Write '0' (we don't want the Ada spurious space).
      Stream.Write (Long_Long_Integer (0));

      Assert_Equals (T, 1, Integer (Stream.Get_Size), "Invalid size for stream");

      Stream.Flush (Buf);
      Assert_Equals (T, 1, Ada.Strings.Unbounded.Length (Buf), "Invalid size for string");

      Assert_Equals (T, "0", Ada.Strings.Unbounded.To_String (Buf), "Invalid stream content");

      Assert_Equals (T, 0, Integer (Stream.Get_Size), "Invalid size for stream after Flush");

      --  Write '1234'
      Stream.Write (Long_Long_Integer (123456789012345));

      Assert_Equals (T, 15, Integer (Stream.Get_Size), "Invalid size for stream");

      Stream.Flush (Buf);
      Assert_Equals (T, 15, Ada.Strings.Unbounded.Length (Buf), "Invalid size for string");

      Assert_Equals (T, "123456789012345", Ada.Strings.Unbounded.To_String (Buf),
                     "Invalid stream content");

      Assert_Equals (T, 0, Integer (Stream.Get_Size), "Invalid size for stream after Flush");

      --  Write '-2345678901234'
      Stream.Write (Long_Long_Integer (-2345678901234));

      Assert_Equals (T, 14, Integer (Stream.Get_Size), "Invalid size for stream");

      Stream.Flush (Buf);
      Assert_Equals (T, 14, Ada.Strings.Unbounded.Length (Buf), "Invalid size for string");

      Assert_Equals (T, "-2345678901234", Ada.Strings.Unbounded.To_String (Buf),
                     "Invalid stream content");

      Assert_Equals (T, 0, Integer (Stream.Get_Size), "Invalid size for stream after Flush");
   end Test_Write_Long_Integer;

   --  ------------------------------
   --  Write on a text stream converting an integer and writing it.
   --  ------------------------------
   procedure Test_Write (T : in out Test) is
      use Ada.Strings.Unbounded;
      Stream  : Print_Stream;
      Buf     : Ada.Strings.Unbounded.Unbounded_String;
   begin
      Stream.Initialize (Size => 10);

      Stream.Write (Ada.Strings.Unbounded.To_Unbounded_String ("hello"));

      Assert_Equals (T, 5, Integer (Stream.Get_Size), "Invalid size for stream");

      Stream.Flush (Buf);
      Assert_Equals (T, 5, Ada.Strings.Unbounded.Length (Buf), "Invalid size for string");

      Assert_Equals (T, "hello", Ada.Strings.Unbounded.To_String (Buf), "Invalid stream content");

      Assert_Equals (T, 0, Integer (Stream.Get_Size), "Invalid size for stream after Flush");

      --  Wide string
      Stream.Write (Ada.Strings.Wide_Wide_Unbounded.To_Unbounded_Wide_Wide_String ("hello"));

      Assert_Equals (T, 5, Integer (Stream.Get_Size), "Invalid size for stream");

      Stream.Flush (Buf);
      Assert_Equals (T, 5, Ada.Strings.Unbounded.Length (Buf), "Invalid size for string");

      Assert_Equals (T, "hello", Ada.Strings.Unbounded.To_String (Buf), "Invalid stream content");

      Assert_Equals (T, 0, Integer (Stream.Get_Size), "Invalid size for stream after Flush");
   end Test_Write;

end Util.Streams.Texts.Tests;

-----------------------------------------------------------------------
--  streams.files.tests -- Unit tests for buffered streams
--  Copyright (C) 2012, 2018, 2019, 2021 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.Streams.Stream_IO;
with Ada.Strings.UTF_Encoding.Wide_Wide_Strings;

with Util.Test_Caller;

with Util.Streams.Files;
with Util.Streams.Texts;
package body Util.Streams.Texts.Tests is

   pragma Wide_Character_Encoding (UTF8);

   use Ada.Streams.Stream_IO;
   use Util.Tests;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Streams.Texts.Open, Read_Line, Close",
                       Test_Read_Line'Access);
      Caller.Add_Test (Suite, "Test Util.Streams.Texts.Write (Integer)",
                       Test_Write_Integer'Access);
      Caller.Add_Test (Suite, "Test Util.Streams.Texts.Write (Long_Long_Integer)",
                       Test_Write_Long_Integer'Access);
      Caller.Add_Test (Suite, "Test Util.Streams.Texts.Write (Unbounded_String)",
                       Test_Write'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test reading a text stream.
   --  ------------------------------
   procedure Test_Read_Line (T : in out Test) is
      Stream : aliased Files.File_Stream;
      Reader : Util.Streams.Texts.Reader_Stream;
      Count  : Natural := 0;
   begin
      Stream.Open (Name => "Makefile", Mode => In_File);
      Reader.Initialize (From => Stream'Access);

      while not Reader.Is_Eof loop
         declare
            Line : Ada.Strings.Unbounded.Unbounded_String;
         begin
            Reader.Read_Line (Line);
            Count := Count + 1;
         end;
      end loop;
      Stream.Close;
      T.Assert (Count > 100, "Too few lines read");
   end Test_Read_Line;

   --  ------------------------------
   --  Write on a text stream converting an integer and writing it.
   --  ------------------------------
   procedure Test_Write_Integer (T : in out Test) is
      Stream  : Print_Stream;
      Buf     : Ada.Strings.Unbounded.Unbounded_String;
   begin
      Stream.Initialize (Size => 4);

      --  Write '0' (we don't want the Ada spurious space).
      Stream.Write (Integer (0));

      Assert_Equals (T, 1, Integer (Stream.Get_Size), "Invalid size for stream");

      Stream.Flush (Buf);
      Assert_Equals (T, 1, Ada.Strings.Unbounded.Length (Buf), "Invalid size for string");

      Assert_Equals (T, "0", Ada.Strings.Unbounded.To_String (Buf), "Invalid stream content");

      Assert_Equals (T, 0, Integer (Stream.Get_Size), "Invalid size for stream after Flush");

      --  Write '1234'
      Stream.Write (Integer (1234));

      Assert_Equals (T, 4, Integer (Stream.Get_Size), "Invalid size for stream");

      Stream.Flush (Buf);
      Assert_Equals (T, 4, Ada.Strings.Unbounded.Length (Buf), "Invalid size for string");

      Assert_Equals (T, "1234", Ada.Strings.Unbounded.To_String (Buf), "Invalid stream content");

      Assert_Equals (T, 0, Integer (Stream.Get_Size), "Invalid size for stream after Flush");

      --  Write '-234'
      Stream.Write (Integer (-234));

      Assert_Equals (T, 4, Integer (Stream.Get_Size), "Invalid size for stream");

      Stream.Flush (Buf);
      Assert_Equals (T, 4, Ada.Strings.Unbounded.Length (Buf), "Invalid size for string");

      Assert_Equals (T, "-234", Ada.Strings.Unbounded.To_String (Buf), "Invalid stream content");

      Assert_Equals (T, 0, Integer (Stream.Get_Size), "Invalid size for stream after Flush");
   end Test_Write_Integer;

   --  ------------------------------
   --  Write on a text stream converting an integer and writing it.
   --  ------------------------------
   procedure Test_Write_Long_Integer (T : in out Test) is
      Stream  : Print_Stream;
      Buf     : Ada.Strings.Unbounded.Unbounded_String;
   begin
      Stream.Initialize (Size => 64);

      --  Write '0' (we don't want the Ada spurious space).
      Stream.Write (Long_Long_Integer (0));

      Assert_Equals (T, 1, Integer (Stream.Get_Size), "Invalid size for stream");

      Stream.Flush (Buf);
      Assert_Equals (T, 1, Ada.Strings.Unbounded.Length (Buf), "Invalid size for string");

      Assert_Equals (T, "0", Ada.Strings.Unbounded.To_String (Buf), "Invalid stream content");

      Assert_Equals (T, 0, Integer (Stream.Get_Size), "Invalid size for stream after Flush");

      --  Write '1234'
      Stream.Write (Long_Long_Integer (123456789012345));

      Assert_Equals (T, 15, Integer (Stream.Get_Size), "Invalid size for stream");

      Stream.Flush (Buf);
      Assert_Equals (T, 15, Ada.Strings.Unbounded.Length (Buf), "Invalid size for string");

      Assert_Equals (T, "123456789012345", Ada.Strings.Unbounded.To_String (Buf),
                     "Invalid stream content");

      Assert_Equals (T, 0, Integer (Stream.Get_Size), "Invalid size for stream after Flush");

      --  Write '-2345678901234'
      Stream.Write (Long_Long_Integer (-2345678901234));

      Assert_Equals (T, 14, Integer (Stream.Get_Size), "Invalid size for stream");

      Stream.Flush (Buf);
      Assert_Equals (T, 14, Ada.Strings.Unbounded.Length (Buf), "Invalid size for string");

      Assert_Equals (T, "-2345678901234", Ada.Strings.Unbounded.To_String (Buf),
                     "Invalid stream content");

      Assert_Equals (T, 0, Integer (Stream.Get_Size), "Invalid size for stream after Flush");
   end Test_Write_Long_Integer;

   --  ------------------------------
   --  Write on a text stream converting an integer and writing it.
   --  ------------------------------
   procedure Test_Write (T : in out Test) is
      use Ada.Strings.UTF_Encoding.Wide_Wide_Strings;

      Stream  : Print_Stream;
      Buf     : Ada.Strings.Unbounded.Unbounded_String;

      Expect  : constant Wide_Wide_String := "àéúíòࠀ€ಜ࠴𝄞" & Wide_Wide_Character'Val (16#0A#);
   begin
      Stream.Initialize (Size => 60);

      Stream.Write (Ada.Strings.Unbounded.To_Unbounded_String ("hello"));

      Assert_Equals (T, 5, Integer (Stream.Get_Size), "Invalid size for stream");

      Stream.Flush (Buf);
      Assert_Equals (T, 5, Ada.Strings.Unbounded.Length (Buf), "Invalid size for string");

      Assert_Equals (T, "hello", Ada.Strings.Unbounded.To_String (Buf), "Invalid stream content");

      Assert_Equals (T, 0, Integer (Stream.Get_Size), "Invalid size for stream after Flush");

      --  Wide string
      Stream.Write (Ada.Strings.Wide_Wide_Unbounded.To_Unbounded_Wide_Wide_String ("hello"));

      Assert_Equals (T, 5, Integer (Stream.Get_Size), "Invalid size for stream");

      Stream.Flush (Buf);
      Assert_Equals (T, 5, Ada.Strings.Unbounded.Length (Buf), "Invalid size for string");

      Assert_Equals (T, "hello", Ada.Strings.Unbounded.To_String (Buf), "Invalid stream content");

      Assert_Equals (T, 0, Integer (Stream.Get_Size), "Invalid size for stream after Flush");

      --  Wide string
      Stream.Write_Wide (Expect);

      Assert_Equals (T, 27, Integer (Stream.Get_Size), "Invalid size for stream");

      Stream.Flush (Buf);
      Assert_Equals (T, 27, Ada.Strings.Unbounded.Length (Buf), "Invalid size for string");

      Assert_Equals (T, Encode (Expect),
                     Ada.Strings.Unbounded.To_String (Buf),
                     "Invalid stream content");

      Assert_Equals (T, 0, Integer (Stream.Get_Size), "Invalid size for stream after Flush");

   end Test_Write;

end Util.Streams.Texts.Tests;

Add test for Write_Wide procedure

Add test for Write_Wide procedure