-----------------------------------------------------------------------
--  Memory Events - Definition and Analysis of memory events
--  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 MAT.Types;
with MAT.Readers.Marshaller;
with MAT.Memory;
with MAT.Events;
package body MAT.Memory.Readers is

   MSG_MALLOC  : constant MAT.Events.Internal_Reference := 0;
   MSG_FREE    : constant MAT.Events.Internal_Reference := 1;
   MSG_REALLOC : constant MAT.Events.Internal_Reference := 2;

   M_SIZE     : constant MAT.Events.Internal_Reference := 1;
   M_FRAME    : constant MAT.Events.Internal_Reference := 2;
   M_ADDR     : constant MAT.Events.Internal_Reference := 3;
   M_OLD_ADDR : constant MAT.Events.Internal_Reference := 4;
   M_THREAD   : constant MAT.Events.Internal_Reference := 5;
   M_UNKNOWN  : constant MAT.Events.Internal_Reference := 6;
   M_TIME     : constant MAT.Events.Internal_Reference := 7;
   --  Defines the possible data kinds which are recognized by
   --  the memory unmarshaller.  All others are ignored.

   SIZE_NAME  : aliased constant String := "size";
   FRAME_NAME : aliased constant String := "frame";
   ADDR_NAME  : aliased constant String := "addr";
   OLD_NAME   : aliased constant String := "old-pointer";
   THREAD_NAME : aliased constant String := "thread";
   TIME_NAME   : aliased constant String := "time";

   Memory_Attributes : aliased constant MAT.Events.Attribute_Table :=
     (1 => (Name => SIZE_NAME'Access, Size => 0,
            Kind => MAT.Events.T_SIZE_T, Ref => M_SIZE),
      2 => (Name => FRAME_NAME'Access, Size => 0,
            Kind => MAT.Events.T_FRAME, Ref => M_FRAME),
      3 => (Name => ADDR_NAME'Access, Size => 0,
            Kind => MAT.Events.T_POINTER, Ref => M_ADDR),
      4 => (Name => OLD_NAME'Access, Size => 0,
            Kind => MAT.Events.T_POINTER, Ref => M_ADDR),
      5 => (Name => THREAD_NAME'Access, Size => 0,
            Kind => MAT.Events.T_THREAD, Ref => M_THREAD),
      6 => (Name => TIME_NAME'Access, Size => 0,
            Kind => MAT.Events.T_TIME, Ref => M_TIME));

   ----------------------
   --  Bind the servant with the object adapter to register the
   --  events it recognizes.
   ----------------------
   procedure Bind (For_Servant : in out Memory_Servant) is
   begin
      Bind_Servant (For_Servant, "malloc", MSG_MALLOC,
                    Memory_Attributes'Access);
      Bind_Servant (For_Servant, "free", MSG_FREE,
                    Memory_Attributes'Access);
      Bind_Servant (For_Servant, "realloc", MSG_REALLOC,
                    Memory_Attributes'Access);
   end Bind;

   ----------------------
   --  A memory allocation message is received.  Register the memory
   --  slot in the allocated memory list.  An event is posted on the
   --  event channel to notify the listeners that a new slot is allocated.
   ----------------------
   procedure Process_Malloc_Message (Client : in out Memory_Servant;
                                     Addr   : in MAT.Types.Target_Addr;
                                     Slot   : in Allocation) is
      Inserted : Boolean;
--        Ev       : MAT.Memory.Events.Memory_Event := (Kind => EV_MALLOC, Addr => Addr);
   begin
      Client.Data.Memory_Slots.Insert (Addr, Slot);
--        Post (Client.Event_Channel, Ev);
   end Process_Malloc_Message;

   ----------------------
   --  A memory deallocation message.  Find the memory slot being freed
   --  and remove it from the allocated list.  Post an event on the event
   --  channel to notify the listeners that the slot is removed.
   ----------------------
   procedure Process_Free_Message (Client : in out Memory_Servant;
                                   Addr   : in MAT.Types.Target_Addr;
                                   Slot   : in Allocation) is
      It : MAT.Memory.Allocation_Maps.Cursor := Client.Data.Memory_Slots.Find (Addr);
--        Ev : Memory_Event := (Kind => EV_FREE, Addr => Addr);
   begin
      if MAT.Memory.Allocation_Maps.Has_Element (It) then
         --  Address is not in the map.  The application is freeing
         --  an already freed memory or something wrong.
         null;
      end if;
--        Post (Client.Event_Channel, Ev);
      declare
         Slot : Allocation := MAT.Memory.Allocation_Maps.Element (It);
      begin
         Frames.Release (Slot.Frame);
      end;

      --  Remove the memory slot from our map.
      Client.Data.Memory_Slots.Delete (It);
   end Process_Free_Message;

   ----------------------
   --  Unmarshall from the message the memory slot information.
   --  The data is described by the Defs table.
   ----------------------
   procedure Unmarshall_Allocation (Msg      : in out MAT.Readers.Message;
                                    Slot     : in out Allocation;
                                    Addr     : in out MAT.Types.Target_Addr;
                                    Old_Addr : in out MAT.Types.Target_Addr;
                                    Defs     : in MAT.Events.Attribute_Table) is
   begin
      for I in Defs'Range loop
         declare
            Def : MAT.Events.Attribute renames Defs (I);
         begin
            case Def.Ref is
               when M_SIZE =>
                  Slot.Size := MAT.Readers.Marshaller.Get_Target_Size (Msg.Buffer, Def.Kind);

               when M_ADDR =>
                  Addr := MAT.Readers.Marshaller.Get_Target_Addr (Msg.Buffer, Def.Kind);

               when M_OLD_ADDR =>
                  Old_Addr := MAT.Readers.Marshaller.Get_Target_Addr (Msg.Buffer, Def.Kind);

               when M_FRAME =>
                  --  Unmarshal_Frame (Msg, Slot.Frame);
                  null;
                  pragma Assert (False, "must fix M_FRAME");

               when M_TIME =>
                  Slot.Time := MAT.Readers.Marshaller.Get_Target_Tick (Msg.Buffer, Def.Kind);

               when M_THREAD =>
                  Slot.Thread := MAT.Readers.Marshaller.Get_Target_Thread (Msg.Buffer, Def.Kind);

               when M_UNKNOWN =>
                  MAT.Readers.Marshaller.Skip (Msg.Buffer, Def.Size);

               when others =>
                  MAT.Readers.Marshaller.Skip (Msg.Buffer, Def.Size);
            end case;
         end;
      end loop;
   end Unmarshall_Allocation;

   overriding
   procedure Dispatch (For_Servant : in out Memory_Servant;
                       Id          : in MAT.Events.Internal_Reference;
                       Params      : in MAT.Events.Const_Attribute_Table_Access;
                       Msg         : in out MAT.Readers.Message) is
      Slot     : Allocation;
      Addr     : MAT.Types.Target_Addr;
      Old_Addr : MAT.Types.Target_Addr := 0;
   begin
      case Id is
         when MSG_MALLOC =>
            Unmarshall_Allocation (Msg, Slot, Addr, Old_Addr, Params.all);
            Process_Malloc_Message (For_Servant, Addr, Slot);

         when MSG_FREE =>
            Unmarshall_Allocation (Msg, Slot, Addr, Old_Addr, Params.all);
            Process_Free_Message (For_Servant, Addr, Slot);

         when MSG_REALLOC =>
            Unmarshall_Allocation (Msg, Slot, Addr, Old_Addr, Params.all);
            Process_Malloc_Message (For_Servant, Addr, Slot);
            Process_Free_Message (For_Servant, Old_Addr, Slot);

         when others =>
            raise Program_Error;

      end case;
   end Dispatch;

end MAT.Memory.Readers;

-----------------------------------------------------------------------
--  Memory Events - Definition and Analysis of memory events
--  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 MAT.Types;
with MAT.Readers.Marshaller;
with MAT.Memory;
with MAT.Events;
package body MAT.Memory.Readers is

   MSG_MALLOC  : constant MAT.Events.Internal_Reference := 0;
   MSG_FREE    : constant MAT.Events.Internal_Reference := 1;
   MSG_REALLOC : constant MAT.Events.Internal_Reference := 2;

   M_SIZE     : constant MAT.Events.Internal_Reference := 1;
   M_FRAME    : constant MAT.Events.Internal_Reference := 2;
   M_ADDR     : constant MAT.Events.Internal_Reference := 3;
   M_OLD_ADDR : constant MAT.Events.Internal_Reference := 4;
   M_THREAD   : constant MAT.Events.Internal_Reference := 5;
   M_UNKNOWN  : constant MAT.Events.Internal_Reference := 6;
   M_TIME     : constant MAT.Events.Internal_Reference := 7;
   --  Defines the possible data kinds which are recognized by
   --  the memory unmarshaller.  All others are ignored.

   SIZE_NAME  : aliased constant String := "size";
   FRAME_NAME : aliased constant String := "frame";
   ADDR_NAME  : aliased constant String := "addr";
   OLD_NAME   : aliased constant String := "old-pointer";
   THREAD_NAME : aliased constant String := "thread";
   TIME_NAME   : aliased constant String := "time";

   Memory_Attributes : aliased constant MAT.Events.Attribute_Table :=
     (1 => (Name => SIZE_NAME'Access, Size => 0,
            Kind => MAT.Events.T_SIZE_T, Ref => M_SIZE),
      2 => (Name => FRAME_NAME'Access, Size => 0,
            Kind => MAT.Events.T_FRAME, Ref => M_FRAME),
      3 => (Name => ADDR_NAME'Access, Size => 0,
            Kind => MAT.Events.T_POINTER, Ref => M_ADDR),
      4 => (Name => OLD_NAME'Access, Size => 0,
            Kind => MAT.Events.T_POINTER, Ref => M_ADDR),
      5 => (Name => THREAD_NAME'Access, Size => 0,
            Kind => MAT.Events.T_THREAD, Ref => M_THREAD),
      6 => (Name => TIME_NAME'Access, Size => 0,
            Kind => MAT.Events.T_TIME, Ref => M_TIME));

   ----------------------
   --  Register the reader to extract and analyze memory events.
   ----------------------
   procedure Register (Into   : in out MAT.Readers.Manager_Base'Class;
                       Reader : in Memory_Reader_Access) is
   begin
      Into.Register_Reader (Reader.all'Access, "malloc", MSG_MALLOC,
                            Memory_Attributes'Access);
      Into.Register_Reader (Reader.all'Access, "free", MSG_FREE,
                            Memory_Attributes'Access);
      Into.Register_Reader (Reader.all'Access, "realloc", MSG_REALLOC,
                            Memory_Attributes'Access);
   end Register;

   ----------------------
   --  A memory allocation message is received.  Register the memory
   --  slot in the allocated memory list.  An event is posted on the
   --  event channel to notify the listeners that a new slot is allocated.
   ----------------------
   procedure Process_Malloc_Message (Client : in out Memory_Servant;
                                     Addr   : in MAT.Types.Target_Addr;
                                     Slot   : in Allocation) is
      Inserted : Boolean;
--        Ev       : MAT.Memory.Events.Memory_Event := (Kind => EV_MALLOC, Addr => Addr);
   begin
      Client.Data.Memory_Slots.Insert (Addr, Slot);
--        Post (Client.Event_Channel, Ev);
   end Process_Malloc_Message;

   ----------------------
   --  A memory deallocation message.  Find the memory slot being freed
   --  and remove it from the allocated list.  Post an event on the event
   --  channel to notify the listeners that the slot is removed.
   ----------------------
   procedure Process_Free_Message (Client : in out Memory_Servant;
                                   Addr   : in MAT.Types.Target_Addr;
                                   Slot   : in Allocation) is
      It : MAT.Memory.Allocation_Maps.Cursor := Client.Data.Memory_Slots.Find (Addr);
--        Ev : Memory_Event := (Kind => EV_FREE, Addr => Addr);
   begin
      if MAT.Memory.Allocation_Maps.Has_Element (It) then
         --  Address is not in the map.  The application is freeing
         --  an already freed memory or something wrong.
         null;
      end if;
--        Post (Client.Event_Channel, Ev);
      declare
         Slot : Allocation := MAT.Memory.Allocation_Maps.Element (It);
      begin
         Frames.Release (Slot.Frame);
      end;

      --  Remove the memory slot from our map.
      Client.Data.Memory_Slots.Delete (It);
   end Process_Free_Message;

   ----------------------
   --  Unmarshall from the message the memory slot information.
   --  The data is described by the Defs table.
   ----------------------
   procedure Unmarshall_Allocation (Msg      : in out MAT.Readers.Message;
                                    Slot     : in out Allocation;
                                    Addr     : in out MAT.Types.Target_Addr;
                                    Old_Addr : in out MAT.Types.Target_Addr;
                                    Defs     : in MAT.Events.Attribute_Table) is
   begin
      for I in Defs'Range loop
         declare
            Def : MAT.Events.Attribute renames Defs (I);
         begin
            case Def.Ref is
               when M_SIZE =>
                  Slot.Size := MAT.Readers.Marshaller.Get_Target_Size (Msg.Buffer, Def.Kind);

               when M_ADDR =>
                  Addr := MAT.Readers.Marshaller.Get_Target_Addr (Msg.Buffer, Def.Kind);

               when M_OLD_ADDR =>
                  Old_Addr := MAT.Readers.Marshaller.Get_Target_Addr (Msg.Buffer, Def.Kind);

               when M_FRAME =>
                  --  Unmarshal_Frame (Msg, Slot.Frame);
                  null;
                  pragma Assert (False, "must fix M_FRAME");

               when M_TIME =>
                  Slot.Time := MAT.Readers.Marshaller.Get_Target_Tick (Msg.Buffer, Def.Kind);

               when M_THREAD =>
                  Slot.Thread := MAT.Readers.Marshaller.Get_Target_Thread (Msg.Buffer, Def.Kind);

               when M_UNKNOWN =>
                  MAT.Readers.Marshaller.Skip (Msg.Buffer, Def.Size);

               when others =>
                  MAT.Readers.Marshaller.Skip (Msg.Buffer, Def.Size);
            end case;
         end;
      end loop;
   end Unmarshall_Allocation;

   overriding
   procedure Dispatch (For_Servant : in out Memory_Servant;
                       Id          : in MAT.Events.Internal_Reference;
                       Params      : in MAT.Events.Const_Attribute_Table_Access;
                       Msg         : in out MAT.Readers.Message) is
      Slot     : Allocation;
      Addr     : MAT.Types.Target_Addr;
      Old_Addr : MAT.Types.Target_Addr := 0;
   begin
      case Id is
         when MSG_MALLOC =>
            Unmarshall_Allocation (Msg, Slot, Addr, Old_Addr, Params.all);
            Process_Malloc_Message (For_Servant, Addr, Slot);

         when MSG_FREE =>
            Unmarshall_Allocation (Msg, Slot, Addr, Old_Addr, Params.all);
            Process_Free_Message (For_Servant, Addr, Slot);

         when MSG_REALLOC =>
            Unmarshall_Allocation (Msg, Slot, Addr, Old_Addr, Params.all);
            Process_Malloc_Message (For_Servant, Addr, Slot);
            Process_Free_Message (For_Servant, Old_Addr, Slot);

         when others =>
            raise Program_Error;

      end case;
   end Dispatch;

end MAT.Memory.Readers;

Remove Bind and implement Register

Remove Bind and implement Register


-----------------------------------------------------------------------
--  util-commands -- Support to make command line tools
--  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.
-----------------------------------------------------------------------
with Ada.Command_Line;
package body Util.Commands is

   --  ------------------------------
   --  Get the number of arguments available.
   --  ------------------------------
   overriding
   function Get_Count (List : in Default_Argument_List) return Natural is
   begin
      return Ada.Command_Line.Argument_Count - List.Offset;
   end Get_Count;

   --  ------------------------------
   --  Get the argument at the given position.
   --  ------------------------------
   overriding
   function Get_Argument (List : in Default_Argument_List;
                          Pos  : in Positive) return String is
   begin
      return Ada.Command_Line.Argument (Pos + List.Offset);
   end Get_Argument;

   --  ------------------------------
   --  Get the command name.
   --  ------------------------------
   function Get_Command_Name (List : in Default_Argument_List) return String is
   begin
      return Ada.Command_Line.Command_Name;
   end Get_Command_Name;

end Util.Commands;

-----------------------------------------------------------------------
--  util-commands -- Support to make command line tools
--  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.
-----------------------------------------------------------------------
with Ada.Command_Line;
package body Util.Commands is

   --  ------------------------------
   --  Get the number of arguments available.
   --  ------------------------------
   overriding
   function Get_Count (List : in Default_Argument_List) return Natural is
      Count : constant Natural := Ada.Command_Line.Argument_Count;
   begin
      if Count > List.Offset then
         return Count - List.Offset;
      else
         return 0;
      end if;
   end Get_Count;

   --  ------------------------------
   --  Get the argument at the given position.
   --  ------------------------------
   overriding
   function Get_Argument (List : in Default_Argument_List;
                          Pos  : in Positive) return String is
   begin
      return Ada.Command_Line.Argument (Pos + List.Offset);
   end Get_Argument;

   --  ------------------------------
   --  Get the command name.
   --  ------------------------------
   function Get_Command_Name (List : in Default_Argument_List) return String is
   begin
      return Ada.Command_Line.Command_Name;
   end Get_Command_Name;

end Util.Commands;

Fix Get_Count operation

Fix Get_Count operation


-----------------------------------------------------------------------
--  util-encoders -- Encode/Decode streams and strings from one format to another
--  Copyright (C) 2009, 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.Unchecked_Deallocation;
with Util.Encoders.Base16;
with Util.Encoders.Base64;
with Util.Encoders.SHA1;
package body Util.Encoders is

   use Ada;
   use Ada.Strings.Unbounded;

   use type Ada.Streams.Stream_Element_Offset;

   --  ------------------------------
   --  Encodes the input string Data using the transformation
   --  rules provided by the E encoder.
   --
   --  Returns the encoded string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be encoded.
   --  Raises the Not_Supported exception if the encoding is not
   --  supported.
   --  ------------------------------
   function Encode (E    : in Encoder;
                    Data : in String) return String is
   begin
      if E.Encode = null then
         raise Not_Supported with "There is no encoder";
      end if;
      return E.Encode.Transform (Data);
   end Encode;

   --  ------------------------------
   --  Decodes the input string Data using the transformation
   --  rules provided by the E encoder.
   --
   --  Returns the encoded string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be decoded.
   --  Raises the Not_Supported exception if the decoding is not
   --  supported.
   --  ------------------------------
   function Decode (E    : in Encoder;
                    Data : in String) return String is
   begin
      if E.Decode = null then
         raise Not_Supported with "There is no decoder";
      end if;
      return E.Decode.Transform (Data);
   end Decode;

   MIN_BUFFER_SIZE : constant Streams.Stream_Element_Offset := 64;
   MAX_BUFFER_SIZE : constant Streams.Stream_Element_Offset := 2_048;

   function Best_Size (Length : Natural) return Streams.Stream_Element_Offset;
   pragma Inline (Best_Size);

   --  ------------------------------
   --  Compute a good size for allocating a buffer on the stack
   --  ------------------------------
   function Best_Size (Length : Natural) return Streams.Stream_Element_Offset is
   begin
      if Length < Natural (MIN_BUFFER_SIZE) then
         return MIN_BUFFER_SIZE;
      elsif Length > Natural (MAX_BUFFER_SIZE) then
         return MAX_BUFFER_SIZE;
      else
         return Streams.Stream_Element_Offset (((Length + 15) / 16) * 16);
      end if;
   end Best_Size;

   --  ------------------------------
   --  Transform the input string Data using the transformation
   --  rules provided by the E transformer.
   --
   --  Returns the transformed string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be transformed
   --  ------------------------------
   function Transform (E    : in Transformer'Class;
                       Data : in String) return String is
      Buf_Size : constant Streams.Stream_Element_Offset := Best_Size (Data'Length);
      Buf      : Streams.Stream_Element_Array (1 .. Buf_Size);
      Res      : Streams.Stream_Element_Array (1 .. Buf_Size);
      Tmp      : String (1 .. Natural (Buf_Size));
      Result   : Ada.Strings.Unbounded.Unbounded_String;
      Pos      : Natural := Data'First;
   begin
      while Pos <= Data'Last loop
         declare
            Last_Encoded  : Streams.Stream_Element_Offset;
            First_Encoded : Streams.Stream_Element_Offset := 1;
            Last          : Streams.Stream_Element_Offset;
            Size          : Streams.Stream_Element_Offset;
            Next_Pos      : Natural;
         begin
            --  Fill the stream buffer with our input string
            Size := Streams.Stream_Element_Offset (Data'Last - Pos + 1);
            if Size > Buf'Length then
               Size := Buf'Length;
            end if;
            for I in 1 .. Size loop
               Buf (I) := Character'Pos (Data (Natural (I) + Pos - 1));
            end loop;
            Next_Pos := Pos + Natural (Size);

            --  Encode that buffer and put the result in out result string.
            loop
               E.Transform (Data    => Buf (First_Encoded .. Size),
                            Into    => Res,
                            Encoded => Last_Encoded,
                            Last    => Last);

               --  If the encoder generated nothing, move the position backward
               --  to take into account the remaining bytes not taken into account.
               if Last < 1 then
                  Next_Pos := Next_Pos - Natural (Size - First_Encoded + 1);
                  exit;
               end if;
               for I in 1 .. Last loop
                  Tmp (Natural (I)) := Character'Val (Res (I));
               end loop;
               Append (Result, Tmp (1 .. Natural (Last)));
               exit when Last_Encoded = Size;
               First_Encoded := Last_Encoded + 1;
            end loop;

            --  The encoder cannot encode the data
            if Pos = Next_Pos then
               raise Encoding_Error with "Encoding cannot proceed";
            end if;
            Pos := Next_Pos;
         end;
      end loop;
      return To_String (Result);
   end Transform;

   --  ------------------------------
   --  Transform the input string Data using the transformation
   --  rules provided by the E transformer.
   --
   --  Returns the transformed string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be transformed
   --  ------------------------------
   function Transform (E    : in Transformer'Class;
                       Data : in Streams.Stream_Element_Array) return String is
      Buf_Size : constant Streams.Stream_Element_Offset := Best_Size (Data'Length);
      Res      : Streams.Stream_Element_Array (1 .. Buf_Size);
      Tmp      : String (1 .. Natural (Buf_Size));
      Result   : Ada.Strings.Unbounded.Unbounded_String;
      Last_Encoded  : Streams.Stream_Element_Offset;
      Last          : Streams.Stream_Element_Offset;
   begin

      --  Encode that buffer and put the result in out result string.
      E.Transform (Data    => Data,
                   Into    => Res,
                   Encoded => Last_Encoded,
                   Last    => Last);

      for I in 1 .. Last loop
         Tmp (Natural (I)) := Character'Val (Res (I));
      end loop;
      Append (Result, Tmp (1 .. Natural (Last)));
      return To_String (Result);
   end Transform;

   --  ------------------------------
   --  Create the encoder object for the specified algorithm.
   --  ------------------------------
   function Create (Name : String) return Encoder is
   begin
      if Name = BASE_16 or Name = HEX then
         return E : Encoder do
            E.Encode := new Util.Encoders.Base16.Encoder;
            E.Decode := new Util.Encoders.Base16.Decoder;
         end return;

      elsif Name = BASE_64 then
         return E : Encoder do
            E.Encode := new Util.Encoders.Base64.Encoder;
            E.Decode := new Util.Encoders.Base64.Decoder;
         end return;

      elsif Name = BASE_64_URL then
         return E : Encoder do
            E.Encode := new Util.Encoders.Base64.Encoder;
            E.Decode := new Util.Encoders.Base64.Decoder;
         end return;

      elsif Name = HASH_SHA1 then
         return E : Encoder do
            E.Encode := new Util.Encoders.SHA1.Encoder;
            E.Decode := new Util.Encoders.Base64.Decoder;
         end return;
      end if;
      raise Storage_Error;
   end Create;

   --  ------------------------------
   --  Delete the transformers
   --  ------------------------------
   overriding
   procedure Finalize (E : in out Encoder) is

      procedure Free is
        new Ada.Unchecked_Deallocation (Transformer'Class, Transformer_Access);

   begin
      Free (E.Encode);
      Free (E.Decode);
   end Finalize;

end Util.Encoders;

-----------------------------------------------------------------------
--  util-encoders -- Encode/Decode streams and strings from one format to another
--  Copyright (C) 2009, 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.Unchecked_Deallocation;
with Util.Encoders.Base16;
with Util.Encoders.Base64;
with Util.Encoders.SHA1;
package body Util.Encoders is

   use Ada;
   use Ada.Strings.Unbounded;

   use type Ada.Streams.Stream_Element_Offset;

   --  ------------------------------
   --  Encodes the input string Data using the transformation
   --  rules provided by the E encoder.
   --
   --  Returns the encoded string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be encoded.
   --  Raises the Not_Supported exception if the encoding is not
   --  supported.
   --  ------------------------------
   function Encode (E    : in Encoder;
                    Data : in String) return String is
   begin
      if E.Encode = null then
         raise Not_Supported with "There is no encoder";
      end if;
      return E.Encode.Transform (Data);
   end Encode;

   --  ------------------------------
   --  Decodes the input string Data using the transformation
   --  rules provided by the E encoder.
   --
   --  Returns the encoded string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be decoded.
   --  Raises the Not_Supported exception if the decoding is not
   --  supported.
   --  ------------------------------
   function Decode (E    : in Encoder;
                    Data : in String) return String is
   begin
      if E.Decode = null then
         raise Not_Supported with "There is no decoder";
      end if;
      return E.Decode.Transform (Data);
   end Decode;

   MIN_BUFFER_SIZE : constant Streams.Stream_Element_Offset := 64;
   MAX_BUFFER_SIZE : constant Streams.Stream_Element_Offset := 2_048;

   function Best_Size (Length : Natural) return Streams.Stream_Element_Offset;
   pragma Inline (Best_Size);

   --  ------------------------------
   --  Compute a good size for allocating a buffer on the stack
   --  ------------------------------
   function Best_Size (Length : Natural) return Streams.Stream_Element_Offset is
   begin
      if Length < Natural (MIN_BUFFER_SIZE) then
         return MIN_BUFFER_SIZE;
      elsif Length > Natural (MAX_BUFFER_SIZE) then
         return MAX_BUFFER_SIZE;
      else
         return Streams.Stream_Element_Offset (((Length + 15) / 16) * 16);
      end if;
   end Best_Size;

   --  ------------------------------
   --  Transform the input string Data using the transformation
   --  rules provided by the E transformer.
   --
   --  Returns the transformed string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be transformed
   --  ------------------------------
   function Transform (E    : in Transformer'Class;
                       Data : in String) return String is
      Buf_Size : constant Streams.Stream_Element_Offset := Best_Size (Data'Length);
      Buf      : Streams.Stream_Element_Array (1 .. Buf_Size);
      Res      : Streams.Stream_Element_Array (1 .. Buf_Size);
      Tmp      : String (1 .. Natural (Buf_Size));
      Result   : Ada.Strings.Unbounded.Unbounded_String;
      Pos      : Natural := Data'First;
   begin
      while Pos <= Data'Last loop
         declare
            Last_Encoded  : Streams.Stream_Element_Offset;
            First_Encoded : Streams.Stream_Element_Offset := 1;
            Last          : Streams.Stream_Element_Offset;
            Size          : Streams.Stream_Element_Offset;
            Next_Pos      : Natural;
         begin
            --  Fill the stream buffer with our input string
            Size := Streams.Stream_Element_Offset (Data'Last - Pos + 1);
            if Size > Buf'Length then
               Size := Buf'Length;
            end if;
            for I in 1 .. Size loop
               Buf (I) := Character'Pos (Data (Natural (I) + Pos - 1));
            end loop;
            Next_Pos := Pos + Natural (Size);

            --  Encode that buffer and put the result in out result string.
            loop
               E.Transform (Data    => Buf (First_Encoded .. Size),
                            Into    => Res,
                            Encoded => Last_Encoded,
                            Last    => Last);

               --  If the encoder generated nothing, move the position backward
               --  to take into account the remaining bytes not taken into account.
               if Last < 1 then
                  Next_Pos := Next_Pos - Natural (Size - First_Encoded + 1);
                  exit;
               end if;
               for I in 1 .. Last loop
                  Tmp (Natural (I)) := Character'Val (Res (I));
               end loop;
               Append (Result, Tmp (1 .. Natural (Last)));
               exit when Last_Encoded = Size;
               First_Encoded := Last_Encoded + 1;
            end loop;

            --  The encoder cannot encode the data
            if Pos = Next_Pos then
               raise Encoding_Error with "Encoding cannot proceed";
            end if;
            Pos := Next_Pos;
         end;
      end loop;
      return To_String (Result);
   end Transform;

   --  ------------------------------
   --  Transform the input string Data using the transformation
   --  rules provided by the E transformer.
   --
   --  Returns the transformed string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be transformed
   --  ------------------------------
   function Transform (E    : in Transformer'Class;
                       Data : in Streams.Stream_Element_Array) return String is
      Buf_Size : constant Streams.Stream_Element_Offset := Best_Size (Data'Length);
      Res      : Streams.Stream_Element_Array (1 .. Buf_Size);
      Tmp      : String (1 .. Natural (Buf_Size));
      Result   : Ada.Strings.Unbounded.Unbounded_String;
      Last_Encoded  : Streams.Stream_Element_Offset;
      Last          : Streams.Stream_Element_Offset;
   begin

      --  Encode that buffer and put the result in out result string.
      E.Transform (Data    => Data,
                   Into    => Res,
                   Encoded => Last_Encoded,
                   Last    => Last);

      for I in 1 .. Last loop
         Tmp (Natural (I)) := Character'Val (Res (I));
      end loop;
      Append (Result, Tmp (1 .. Natural (Last)));
      return To_String (Result);
   end Transform;

   --  ------------------------------
   --  Create the encoder object for the specified algorithm.
   --  ------------------------------
   function Create (Name : String) return Encoder is
   begin
      if Name = BASE_16 or Name = HEX then
         return E : Encoder do
            E.Encode := new Util.Encoders.Base16.Encoder;
            E.Decode := new Util.Encoders.Base16.Decoder;
         end return;

      elsif Name = BASE_64 then
         return E : Encoder do
            E.Encode := new Util.Encoders.Base64.Encoder;
            E.Decode := new Util.Encoders.Base64.Decoder;
         end return;

      elsif Name = BASE_64_URL then
         return E : Encoder do
            E.Encode := new Util.Encoders.Base64.Encoder;
            E.Decode := new Util.Encoders.Base64.Decoder;
         end return;

      elsif Name = HASH_SHA1 then
         return E : Encoder do
            E.Encode := new Util.Encoders.SHA1.Encoder;
            E.Decode := new Util.Encoders.Base64.Decoder;
         end return;
      end if;
      raise Not_Supported with "Invalid encoder: " & Name;
   end Create;

   --  ------------------------------
   --  Delete the transformers
   --  ------------------------------
   overriding
   procedure Finalize (E : in out Encoder) is

      procedure Free is
        new Ada.Unchecked_Deallocation (Transformer'Class, Transformer_Access);

   begin
      Free (E.Encode);
      Free (E.Decode);
   end Finalize;

end Util.Encoders;

Raise the Not_Supported exception instead of Storage_Error if the encoder is not supported.


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

package body EL.Methods.Func_1 is

   use EL.Expressions;

   --  ------------------------------
   --  Returns True if the method is a valid method which accepts the arguments
   --  defined by the package instantiation.
   --  ------------------------------
   function Is_Valid (Method : in EL.Expressions.Method_Info) return Boolean is
   begin
      if Method.Binding = null then
         return False;
      else
         return Method.Binding.all in Binding'Class;
      end if;
   end Is_Valid;

   --  ------------------------------
   --  Execute the method describe by the method expression
   --  and with the given context.  The method signature is:
   --
   --   function F (Obj : <Bean>; Param : Param1_Type) return Return_Type;
   --
   --  where <Bean> inherits from Readonly_Bean
   --  (See Bind package)
   --
   --  Raises Invalid_Method if the method referenced by
   --  the method expression does not exist or does not match
   --  the signature.
   --  ------------------------------
   function Execute (Method  : in EL.Expressions.Method_Expression'Class;
                     Param   : in Param1_Type;
                     Context : in EL.Contexts.ELContext'Class) return Return_Type is
      Info   : constant Method_Info := Method.Get_Method_Info (Context);
   begin
      if Info.Binding = null then
         raise EL.Expressions.Invalid_Method with "Method not found";
      end if;

      --  If the binding has the wrong type, we are trying to invoke
      --  a method with a different signature.
      if not (Info.Binding.all in Binding'Class) then
         raise EL.Expressions.Invalid_Method
         with "Invalid signature for method '" & Info.Binding.Name.all & "'";
      end if;
      declare
         Proxy  : constant Binding_Access := Binding (Info.Binding.all)'Access;
      begin
         return Proxy.Method (Info.Object.all, Param);
      end;
   end Execute;

   --  ------------------------------
   --  Proxy for the binding.
   --  The proxy declares the binding definition that links
   --  the name to the function and it implements the necessary
   --  object conversion to translate the Readonly_Bean
   --  object to the target object type.
   --  ------------------------------
   package body Bind is
      function Method_Access (O  : Util.Beans.Basic.Readonly_Bean'Class;
                              P1 : Param1_Type) return Return_Type is
         Object : constant Bean        := Bean (O);
         Result : constant Return_Type := Method (Object, P1);
      begin
         return Result;
      end Method_Access;
   end Bind;

end EL.Methods.Func_1;

-----------------------------------------------------------------------
--  EL.Methods.Func_1 -- Function Bindings with 1 argument
--  Copyright (C) 2010, 2011, 2012, 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.Beans.Objects;
package body EL.Methods.Func_1 is

   use EL.Expressions;

   --  ------------------------------
   --  Returns True if the method is a valid method which accepts the arguments
   --  defined by the package instantiation.
   --  ------------------------------
   function Is_Valid (Method : in EL.Expressions.Method_Info) return Boolean is
   begin
      if Method.Binding = null then
         return False;
      else
         return Method.Binding.all in Binding'Class;
      end if;
   end Is_Valid;

   --  ------------------------------
   --  Execute the method describe by the method expression
   --  and with the given context.  The method signature is:
   --
   --   function F (Obj : <Bean>; Param : Param1_Type) return Return_Type;
   --
   --  where <Bean> inherits from Readonly_Bean
   --  (See Bind package)
   --
   --  Raises Invalid_Method if the method referenced by
   --  the method expression does not exist or does not match
   --  the signature.
   --  ------------------------------
   function Execute (Method  : in EL.Expressions.Method_Expression'Class;
                     Param   : in Param1_Type;
                     Context : in EL.Contexts.ELContext'Class) return Return_Type is
      Info   : constant Method_Info := Method.Get_Method_Info (Context);
   begin
      if Info.Binding = null then
         raise EL.Expressions.Invalid_Method with "Method not found";
      end if;

      --  If the binding has the wrong type, we are trying to invoke
      --  a method with a different signature.
      if not (Info.Binding.all in Binding'Class) then
         raise EL.Expressions.Invalid_Method
         with "Invalid signature for method '" & Info.Binding.Name.all & "'";
      end if;
      declare
         use Util.Beans.Objects;
         Bean   : constant access Util.Beans.Basic.Readonly_Bean'Class := To_Bean (Info.Object);
         Proxy  : constant Binding_Access := Binding (Info.Binding.all)'Access;
      begin
         return Proxy.Method (Bean.all, Param);
      end;
   end Execute;

   --  ------------------------------
   --  Proxy for the binding.
   --  The proxy declares the binding definition that links
   --  the name to the function and it implements the necessary
   --  object conversion to translate the Readonly_Bean
   --  object to the target object type.
   --  ------------------------------
   package body Bind is
      function Method_Access (O  : Util.Beans.Basic.Readonly_Bean'Class;
                              P1 : Param1_Type) return Return_Type is
         Object : constant Bean        := Bean (O);
         Result : constant Return_Type := Method (Object, P1);
      begin
         return Result;
      end Method_Access;
   end Bind;

end EL.Methods.Func_1;

Update use of Method_Info record after change of type for the Object member


-----------------------------------------------------------------------
--  Frames - Representation of stack frames
--  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 MAT.Types; use MAT.Types;
package MAT.Frames is

   Not_Found : exception;

   type Frame is limited private;
   type Frame_Ptr is access all Frame;

   type PC_Table is array (Positive range <>) of Target_Addr;

   function Parent (F : in Frame_Ptr) return Frame_Ptr;
   --  Return the parent frame.

   function Backtrace (F : in Frame_Ptr) return PC_Table;
   --  Returns the backtrace of the current frame (up to the root).

   function Calls (F : in Frame_Ptr) return PC_Table;
   --  Returns all the direct calls made by the current frame.

   function Count_Children (F : in Frame_Ptr;
                            Recursive : in Boolean := False) return Natural;
   --  Returns the number of children in the frame.
   --  When recursive is true, compute in the sub-tree.

   function Current_Depth (F : in Frame_Ptr) return Natural;
   --  Returns the current stack depth (# of calls from the root
   --  to reach the frame).

   function Create_Root return Frame_Ptr;
   --  Create a root for stack frame representation.

   procedure Destroy (Tree : in out Frame_Ptr);
   --  Destroy the frame tree recursively.

   procedure Release (F : in Frame_Ptr);
   --  Release the frame when its reference is no longer necessary.

   procedure Insert (F : in Frame_Ptr;
                     Pc : in Pc_Table;
                     Result : out Frame_Ptr);

   function Find (F : in Frame_Ptr;
                  Pc : in Target_Addr) return Frame_Ptr;
   --  Find the child frame which has the given PC address.
   --  Returns that frame pointer or raises the Not_Found exception.

   function Find (F : in Frame_Ptr;
                  Pc : in Pc_Table) return Frame_Ptr;
   --

   --  Find the child frame which has the given PC address.
   --  Returns that frame pointer or raises the Not_Found exception.
   procedure Find (F       : in Frame_Ptr;
                   Pc      : in PC_Table;
                   Result  : out Frame_Ptr;
                   Last_Pc : out Natural);
private

   Frame_Group_Size : constant Natural := 4;

   subtype Local_Depth_Type is Natural range 0 .. Frame_Group_Size;

   subtype Frame_Table is Pc_Table (1 .. Local_Depth_Type'Last);

   type Frame is record
      Parent   : Frame_Ptr := null;
      Next     : Frame_Ptr := null;
      Children : Frame_Ptr := null;
      Used     : Natural   := 0;
      Depth    : Natural   := 0;
      Calls    : Frame_Table;
      Local_Depth : Local_Depth_Type := 0;
   end record;

end MAT.Frames;

-----------------------------------------------------------------------
--  Frames - Representation of stack frames
--  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 MAT.Types; use MAT.Types;
with MAT.Events;
package MAT.Frames is

   Not_Found : exception;

   type Frame is limited private;
   type Frame_Ptr is access all Frame;

   subtype PC_Table is MAT.Events.Frame_Table;

   function Parent (F : in Frame_Ptr) return Frame_Ptr;
   --  Return the parent frame.

   function Backtrace (F : in Frame_Ptr) return PC_Table;
   --  Returns the backtrace of the current frame (up to the root).

   function Calls (F : in Frame_Ptr) return PC_Table;
   --  Returns all the direct calls made by the current frame.

   function Count_Children (F : in Frame_Ptr;
                            Recursive : in Boolean := False) return Natural;
   --  Returns the number of children in the frame.
   --  When recursive is true, compute in the sub-tree.

   function Current_Depth (F : in Frame_Ptr) return Natural;
   --  Returns the current stack depth (# of calls from the root
   --  to reach the frame).

   function Create_Root return Frame_Ptr;
   --  Create a root for stack frame representation.

   procedure Destroy (Tree : in out Frame_Ptr);
   --  Destroy the frame tree recursively.

   procedure Release (F : in Frame_Ptr);
   --  Release the frame when its reference is no longer necessary.

   procedure Insert (F : in Frame_Ptr;
                     Pc : in Pc_Table;
                     Result : out Frame_Ptr);

   function Find (F : in Frame_Ptr;
                  Pc : in Target_Addr) return Frame_Ptr;
   --  Find the child frame which has the given PC address.
   --  Returns that frame pointer or raises the Not_Found exception.

   function Find (F : in Frame_Ptr;
                  Pc : in Pc_Table) return Frame_Ptr;
   --

   --  Find the child frame which has the given PC address.
   --  Returns that frame pointer or raises the Not_Found exception.
   procedure Find (F       : in Frame_Ptr;
                   Pc      : in PC_Table;
                   Result  : out Frame_Ptr;
                   Last_Pc : out Natural);
private

   Frame_Group_Size : constant Natural := 4;

   subtype Local_Depth_Type is Natural range 0 .. Frame_Group_Size;

   subtype Frame_Table is Pc_Table (1 .. Local_Depth_Type'Last);

   type Frame is record
      Parent   : Frame_Ptr := null;
      Next     : Frame_Ptr := null;
      Children : Frame_Ptr := null;
      Used     : Natural   := 0;
      Depth    : Natural   := 0;
      Calls    : Frame_Table;
      Local_Depth : Local_Depth_Type := 0;
   end record;

end MAT.Frames;

Use the MAT.Events.Frame_Table type

Use the MAT.Events.Frame_Table type


-----------------------------------------------------------------------
--  mat-readers -- Reader
--  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.Containers;
with Ada.Containers.Hashed_Maps;

with System;

with Util.Properties;

with MAT.Types;
with MAT.Events;
package MAT.Readers is

   type Buffer_Type is private;
   type Buffer_Ptr is access Buffer_Type;

   type Message is record
      Kind : MAT.Events.Event_Type;
      Size : Natural;
      Buf  : Buffer_Ptr;
   end record;

   -----------------
   --  Abstract servant definition
   -----------------
   --  The Servant is a small proxy that binds the specific message
   --  handlers to the client specific dispatcher.
   type Reader_Base is abstract tagged limited private;
   type Reader_Access is access all Reader_Base'Class;

   procedure Dispatch (For_Servant : in out Reader_Base;
                       Id          : in MAT.Events.Internal_Reference;
                       Msg         : in out Message) is abstract;
   --  Dispatch the message

   procedure Bind (For_Servant : in out Reader_Base) is abstract;
   --  Bind the servant with the object adapter to register the
   --  events it recognizes.  This is called once we have all the
   --  information about the structures of events that we can
   --  receive.

   -----------------
   --  Ipc Client Manager
   -----------------
   --  The Manager is a kind of object adapter. It registers a collection
   --  of servants and dispatches incomming messages to those servants.
   type Manager_Base is tagged limited private;
   type Manager is access all Manager_Base'Class;

   procedure Register_Servant (Adapter : in Manager;
                               Proxy   : in Reader_Access);
   --  Register the proxy servant in the object adapter.

--     function Get_Manager (Refs : in ClientInfo_Ref_Map) return Manager;
   --  Return the object adapter manager which holds all the servant
   --  for the client.

   procedure Register_Message_Analyzer (Proxy  : in Reader_Access;
                                        Name   : in String;
                                        Id     : in MAT.Events.Internal_Reference;
                                        Model  : in MAT.Events.Attribute_Table;
                                        Table  : out MAT.Events.Attribute_Table_Ptr);
   --  Setup the servant to receive and process messages identified
   --  by Name.

   procedure Dispatch_Message (Client : in out Manager_Base;
                               Msg_Id : in MAT.Events.Internal_Reference;
                               Msg    : in out Message);

private

   type Buffer_Type is record
      Current : System.Address;
      Start   : System.Address;
      Last    : System.Address;
      Size    : Natural;
      Total   : Natural;
   end record;

   type Reader_Base is abstract tagged limited record
      Owner : Manager := null;
   end record;

   --  Record a servant
   type Message_Handler is record
      For_Servant : Reader_Access;
      Id          : MAT.Events.Internal_Reference;
   end record;

   function Hash (Key : in MAT.Events.Internal_Reference) return Ada.Containers.Hash_Type;

   use type MAT.Types.Uint32;

   --  Runtime handlers associated with the events.
   package Handler_Maps is
     new Ada.Containers.Hashed_Maps (Key_Type     => MAT.Events.Internal_Reference,
                                     Element_Type => Message_Handler,
                                     Hash         => Hash,
                                     Equivalent_Keys => "=");

   type Manager_Base is tagged limited record
      Handlers    : Handler_Maps.Map;
   end record;

end MAT.Readers;

-----------------------------------------------------------------------
--  mat-readers -- Reader
--  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.Containers;
with Ada.Containers.Hashed_Maps;

with System;

with Util.Properties;

with MAT.Types;
with MAT.Events;
package MAT.Readers is

   type Buffer_Type is private;
   type Buffer_Ptr is access Buffer_Type;

   type Message is record
      Kind   : MAT.Events.Event_Type;
      Size   : Natural;
      Buffer : Buffer_Ptr;
   end record;

   -----------------
   --  Abstract servant definition
   -----------------
   --  The Servant is a small proxy that binds the specific message
   --  handlers to the client specific dispatcher.
   type Reader_Base is abstract tagged limited private;
   type Reader_Access is access all Reader_Base'Class;

   procedure Dispatch (For_Servant : in out Reader_Base;
                       Id          : in MAT.Events.Internal_Reference;
                       Params      : in MAT.Events.Const_Attribute_Table_Access;
                       Msg         : in out Message) is abstract;
   --  Dispatch the message

   procedure Bind (For_Servant : in out Reader_Base) is abstract;
   --  Bind the servant with the object adapter to register the
   --  events it recognizes.  This is called once we have all the
   --  information about the structures of events that we can
   --  receive.

   -----------------
   --  Ipc Client Manager
   -----------------
   --  The Manager is a kind of object adapter. It registers a collection
   --  of servants and dispatches incomming messages to those servants.
   type Manager_Base is tagged limited private;
   type Manager is access all Manager_Base'Class;

   procedure Register_Servant (Adapter : in Manager;
                               Proxy   : in Reader_Access);
   --  Register the proxy servant in the object adapter.

--     function Get_Manager (Refs : in ClientInfo_Ref_Map) return Manager;
   --  Return the object adapter manager which holds all the servant
   --  for the client.

   procedure Register_Message_Analyzer (Proxy  : in Reader_Access;
                                        Name   : in String;
                                        Id     : in MAT.Events.Internal_Reference;
                                        Model  : in MAT.Events.Attribute_Table;
                                        Table  : out MAT.Events.Attribute_Table_Ptr);
   --  Setup the servant to receive and process messages identified
   --  by Name.

   procedure Dispatch_Message (Client : in out Manager_Base;
                               Msg_Id : in MAT.Events.Internal_Reference;
                               Msg    : in out Message);

private

   type Buffer_Type is record
      Current : System.Address;
      Start   : System.Address;
      Last    : System.Address;
      Size    : Natural;
      Total   : Natural;
   end record;

   type Reader_Base is abstract tagged limited record
      Owner : Manager := null;
   end record;

   --  Record a servant
   type Message_Handler is record
      For_Servant : Reader_Access;
      Id          : MAT.Events.Internal_Reference;
   end record;

   function Hash (Key : in MAT.Events.Internal_Reference) return Ada.Containers.Hash_Type;

   use type MAT.Types.Uint32;

   --  Runtime handlers associated with the events.
   package Handler_Maps is
     new Ada.Containers.Hashed_Maps (Key_Type     => MAT.Events.Internal_Reference,
                                     Element_Type => Message_Handler,
                                     Hash         => Hash,
                                     Equivalent_Keys => "=");

   type Manager_Base is tagged limited record
      Handlers    : Handler_Maps.Map;
   end record;

end MAT.Readers;

Fix the Message and Dispatch definition

Fix the Message and Dispatch definition


-----------------------------------------------------------------------
--  mat-memory-tools - Tools for memory maps
--  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.Memory.Tools is

   --  ------------------------------
   --  Collect the information about memory slot sizes for the memory slots in the map.
   --  ------------------------------
   procedure Size_Information (Memory : in MAT.Memory.Allocation_Map;
                               Sizes  : in out Size_Info_Map) is
      Iter : Allocation_Cursor := Memory.First;

      procedure Update_Count (Size : in MAT.Types.Target_Size;
                              Info : in out Size_Info_Type) is
      begin
         Info.Count := Info.Count + 1;
      end Update_Count;

      procedure Collect (Addr : in MAT.Types.Target_Addr;
                         Slot : in Allocation) is
         Pos : Size_Info_Cursor := Sizes.Find (Slot.Size);
      begin
         if Size_Info_Maps.Has_Element (Pos) then
            Sizes.Update_Element (Pos, Update_Count'Access);
         else
            declare
               Info : Size_Info_Type;
            begin
               Info.Count := 1;
               Sizes.Insert (Slot.Size, Info);
            end;
         end if;
      end Collect;

   begin
      while Allocation_Maps.Has_Element (Iter) loop
         Allocation_Maps.Query_Element (Iter, Collect'Access);
         Allocation_Maps.Next (Iter);
      end loop;
   end Size_Information;

   --  ------------------------------
   --  Find from the <tt>Memory</tt> map the memory slots whose address intersects
   --  the region [From .. To] and add the memory slot in the <tt>Into</tt> list if
   --  it does not already contains the memory slot.
   --  ------------------------------
   procedure Find (Memory : in MAT.Memory.Allocation_Map;
                   From   : in MAT.Types.Target_Addr;
                   To     : in MAT.Types.Target_Addr;
                   Into   : in out MAT.Memory.Allocation_Map) is
      Iter : MAT.Memory.Allocation_Cursor := Memory.Ceiling (From);
      Pos  : MAT.Memory.Allocation_Cursor;
   begin
      while Allocation_Maps.Has_Element (Iter) loop
         declare
            Addr : constant MAT.Types.Target_Addr := Allocation_Maps.Key (Iter);
         begin
            exit when Addr > To;
            Pos := Into.Find (Addr);
            if not Allocation_Maps.Has_Element (Pos) then
               Into.Insert (Addr, Allocation_Maps.Element (Iter));
            end if;
         end;
         Allocation_Maps.Next (Iter);
      end loop;
   end Find;

end MAT.Memory.Tools;

-----------------------------------------------------------------------
--  mat-memory-tools - Tools for memory maps
--  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.Memory.Tools is

   --  ------------------------------
   --  Collect the information about memory slot sizes for the memory slots in the map.
   --  ------------------------------
   procedure Size_Information (Memory : in MAT.Memory.Allocation_Map;
                               Sizes  : in out Size_Info_Map) is
      Iter : Allocation_Cursor := Memory.First;

      procedure Update_Count (Size : in MAT.Types.Target_Size;
                              Info : in out Size_Info_Type) is
      begin
         Info.Count := Info.Count + 1;
      end Update_Count;

      procedure Collect (Addr : in MAT.Types.Target_Addr;
                         Slot : in Allocation) is
         Pos : Size_Info_Cursor := Sizes.Find (Slot.Size);
      begin
         if Size_Info_Maps.Has_Element (Pos) then
            Sizes.Update_Element (Pos, Update_Count'Access);
         else
            declare
               Info : Size_Info_Type;
            begin
               Info.Count := 1;
               Sizes.Insert (Slot.Size, Info);
            end;
         end if;
      end Collect;

   begin
      while Allocation_Maps.Has_Element (Iter) loop
         Allocation_Maps.Query_Element (Iter, Collect'Access);
         Allocation_Maps.Next (Iter);
      end loop;
   end Size_Information;

   --  ------------------------------
   --  Find from the <tt>Memory</tt> map the memory slots whose address intersects
   --  the region [From .. To] and add the memory slot in the <tt>Into</tt> list if
   --  it does not already contains the memory slot.
   --  ------------------------------
   procedure Find (Memory : in MAT.Memory.Allocation_Map;
                   From   : in MAT.Types.Target_Addr;
                   To     : in MAT.Types.Target_Addr;
                   Into   : in out MAT.Memory.Allocation_Map) is
      Iter : MAT.Memory.Allocation_Cursor := Memory.Ceiling (From);
      Pos  : MAT.Memory.Allocation_Cursor;
      Addr : MAT.Types.Target_Addr;
      Size : MAT.Types.Target_Size;
   begin
      --  If there was no slot with the ceiling From address, we have to start from the last
      --  node because the memory slot may intersect our region.
      if not Allocation_Maps.Has_Element (Iter) then
         Iter := Memory.Last;
         if not Allocation_Maps.Has_Element (Iter) then
            return;
         end if;
         Addr := Allocation_Maps.Key (Iter);
         Size := Allocation_Maps.Element (Iter).Size;
         if Addr + Size < From then
            return;
         end if;
      end if;

      --  Move backward until the previous memory slot does not overlap anymore our region.
      --  In theory, going backward once is enough but if there was a target malloc issue,
      --  several malloc may overlap the same region (which is bad for the target).
      loop
         Pos := Allocation_Maps.Previous (Iter);
         exit when not Allocation_Maps.Has_Element (Pos);
         Addr := Allocation_Maps.Key (Pos);
         Size := Allocation_Maps.Element (Pos).Size;
         exit when Addr + Size < From;
         Iter := Pos;
      end loop;

      --  Add the memory slots until we moved to the end of the region.
      while Allocation_Maps.Has_Element (Iter) loop
         Addr := Allocation_Maps.Key (Iter);
         exit when Addr > To;
         Pos := Into.Find (Addr);
         if not Allocation_Maps.Has_Element (Pos) then
            Into.Insert (Addr, Allocation_Maps.Element (Iter));
         end if;
         Allocation_Maps.Next (Iter);
      end loop;
   end Find;

end MAT.Memory.Tools;

Fix the Find procedure when the memory region overlaps the last or first memory slot


-----------------------------------------------------------------------
--  awa-modules-reader -- Read module configuration files
--  Copyright (C) 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 Util.Serialize.IO.XML;
with Util.Serialize.Mappers;

with ASF.Applications.Main;
with ASF.Navigations.Mappers;
with ASF.Servlets.Mappers;
with ASF.Beans.Mappers;

--  The <b>AWA.Modules.Reader</b> package reads the module configuration files
--  and initializes the module.
package body AWA.Modules.Reader is

   --  ------------------------------
   --  Read the module configuration file and configure the components
   --  ------------------------------
   procedure Read_Configuration (Plugin  : in out Module'Class;
                                 File    : in String;
                                 Context : in EL.Contexts.ELContext_Access) is

      procedure Add_Mapper (Mapper : in Util.Serialize.Mappers.Mapper_Access);

      Reader     : Util.Serialize.IO.XML.Parser;
      MBean      : aliased ASF.Beans.Mappers.Managed_Bean;
      Navigation : aliased ASF.Navigations.Mappers.Nav_Config;
      Servlet    : aliased ASF.Servlets.Mappers.Servlet_Config;

      procedure Add_Mapper (Mapper : in Util.Serialize.Mappers.Mapper_Access) is
      begin
         Reader.Add_Mapping ("faces-config", Mapper);
         Reader.Add_Mapping ("module", Mapper);
         Reader.Add_Mapping ("web-app", Mapper);
      end Add_Mapper;

   begin
      Log.Info ("Reading module configuration file {0}", File);

      Add_Mapper (ASF.Beans.Mappers.Get_Managed_Bean_Mapper);
      Add_Mapper (ASF.Navigations.Mappers.Get_Navigation_Mapper);
      Add_Mapper (ASF.Servlets.Mappers.Get_Servlet_Mapper);

      --  Setup the managed bean context to read the <managed-bean> elements.
      --  The ELContext is used for parsing EL expressions defined in property values.
      MBean.Factory := Plugin.Factory'Unchecked_Access;
      MBean.Context := Context;
      ASF.Beans.Mappers.Config_Mapper.Set_Context (Ctx     => Reader,
                                                   Element => MBean'Unchecked_Access);

      --  Setup the navigation context to read the <navigation-rule> elements.
      Navigation.Handler := Plugin.App.Get_Navigation_Handler;
      ASF.Navigations.Mappers.Case_Mapper.Set_Context (Ctx     => Reader,
                                                       Element => Navigation'Unchecked_Access);

      Servlet.Handler := Plugin.App.all'Unchecked_Access;
      ASF.Servlets.Mappers.Servlet_Mapper.Set_Context (Ctx     => Reader,
                                                       Element => Servlet'Unchecked_Access);

      Util.Serialize.IO.Dump (Reader, AWA.Modules.Log);

      --  Read the configuration file and record managed beans, navigation rules.
      Reader.Parse (File);
   end Read_Configuration;

end AWA.Modules.Reader;

-----------------------------------------------------------------------
--  awa-modules-reader -- Read module configuration files
--  Copyright (C) 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 Util.Serialize.IO.XML;

with ASF.Applications.Main;
with ASF.Navigations.Mappers;
with ASF.Servlets.Mappers;
with ASF.Beans.Mappers;

--  The <b>AWA.Modules.Reader</b> package reads the module configuration files
--  and initializes the module.
package body AWA.Modules.Reader is

   --  ------------------------------
   --  Read the module configuration file and configure the components
   --  ------------------------------
   procedure Read_Configuration (Plugin  : in out Module'Class;
                                 File    : in String;
                                 Context : in EL.Contexts.ELContext_Access) is

      Reader     : Util.Serialize.IO.XML.Parser;

      Nav : constant ASF.Navigations.Navigation_Handler_Access := Plugin.App.Get_Navigation_Handler;

      package Bean_Config is
        new ASF.Beans.Mappers.Reader_Config (Reader, Plugin.Factory'Unchecked_Access, Context);
      package Navigation_Config is
        new ASF.Navigations.Mappers.Reader_Config (Reader, Nav);
      package Servlet_Config is
        new ASF.Servlets.Mappers.Reader_Config (Reader, Plugin.App.all'Unchecked_Access);
      pragma Warnings (Off, Bean_Config);
      pragma Warnings (Off, Navigation_Config);
      pragma Warnings (Off, Servlet_Config);
   begin
      Log.Info ("Reading module configuration file {0}", File);

      Util.Serialize.IO.Dump (Reader, AWA.Modules.Log);

      --  Read the configuration file and record managed beans, navigation rules.
      Reader.Parse (File);
   end Read_Configuration;

end AWA.Modules.Reader;

Update Read_Configuration to use the new XXX_Config generic packages.


-----------------------------------------------------------------------
--  gen-model-projects -- Projects meta data
--  Copyright (C) 2011, 2012, 2013, 2014, 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.
-----------------------------------------------------------------------

with Ada.Strings.Unbounded;
with Ada.Containers.Vectors;

with Util.Beans.Objects;
with Util.Properties;

with Gen.Utils;
with Gen.Utils.GNAT;
package Gen.Model.Projects is

   use Ada.Strings.Unbounded;

   type Project_Definition;
   type Project_Definition_Access is access all Project_Definition'Class;

   type Dependency_Type is (NONE, DIRECT, INDIRECT, BOTH);

   type Project_Reference is record
      Project : Project_Definition_Access := null;
      Name    : Unbounded_String;
      Kind    : Dependency_Type := NONE;
   end record;

   package Project_Vectors is
     new Ada.Containers.Vectors (Element_Type => Project_Reference,
                                 Index_Type   => Natural);

   --  ------------------------------
   --  Project Definition
   --  ------------------------------
   type Project_Definition is new Definition with record
      Path    : Unbounded_String;
      Props   : Util.Properties.Manager;
      Modules : Project_Vectors.Vector;

      --  The root project definition.
      Root          : Project_Definition_Access := null;

      --  The list of plugin names that this plugin or project depends on.
      Dependencies  : Project_Vectors.Vector;

      --  The list of GNAT project files used by the project.
      Project_Files : Gen.Utils.GNAT.Project_Info_Vectors.Vector;

      --  The list of 'dynamo.xml' files used by the project (gathered from GNAT files
      --  and by scanning the 'plugins' directory).
      Dynamo_Files  : Gen.Utils.String_List.Vector;

      --  Whether we did a recursive scan of GNAT project files.
      Recursive_Scan : Boolean := False;

      --  Whether we are doing a recursive operation on the project (prevent from cycles).
      Recursing      : Boolean := False;

      --  Whether we did a recursive scan of Dynamo dependencies.
      Depend_Scan    : Boolean := False;

      --  Whether this project is a plugin.
      Is_Plugin      : Boolean := False;
   end record;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   overriding
   function Get_Value (From : Project_Definition;
                       Name : String) return Util.Beans.Objects.Object;

   --  Get the project name.
   function Get_Project_Name (Project : in Project_Definition) return String;

   --  Get the GNAT project file name.  The default is to use the Dynamo project
   --  name and add the .gpr extension.  The gnat_project configuration
   --  property allows to override this default.
   function Get_GNAT_Project_Name (Project : in Project_Definition) return String;

   --  Get the directory path which holds application modules.
   --  This is controlled by the modules_dir configuration property.
   --  The default is <tt>plugins</tt>.
   --  ------------------------------
   function Get_Module_Dir (Project : in Project_Definition) return String;

   --  Find the dependency for the Name plugin.
   --  Returns a null dependency if the project does not depend on that plugin.
   function Find_Dependency (From : in Project_Definition;
                             Name : in String) return Project_Reference;

   --  Add a dependency to the plugin identified by Name.
   procedure Add_Dependency (Into : in out Project_Definition;
                             Name : in String;
                             Kind : in Dependency_Type);

   --  Add a dependency to the plugin identified by Project.
   procedure Add_Dependency (Into    : in out Project_Definition;
                             Project : in Project_Definition_Access;
                             Kind    : in Dependency_Type);

   --  Create a project definition instance to record a project with the dynamo XML file path.
   procedure Create_Project (Into    : in out Project_Definition;
                             Name    : in String;
                             Path    : in String;
                             Project : out Project_Definition_Access);

   --  Add the project in the global project list on the root project instance.
   procedure Add_Project (Into    : in out Project_Definition;
                          Project : in Project_Definition_Access);

   --  Add the project Name as a module.
   procedure Add_Module (Into : in out Project_Definition;
                         Name : in String);

   --  Add the project represented by Project if it is not already part of the modules.
   procedure Add_Module (Into    : in out Project_Definition;
                         Project : in Project_Definition_Access);

   --  Find the project definition associated with the dynamo XML file Path.
   --  Returns null if there is no such project
   function Find_Project (From : in Project_Definition;
                          Path : in String) return Project_Definition_Access;

   --  Find the project definition having the name Name.
   --  Returns null if there is no such project
   function Find_Project_By_Name (From : in Project_Definition;
                                  Name : in String) return Project_Definition_Access;

   --  Save the project description and parameters.
   procedure Save (Project : in out Project_Definition;
                   Path    : in String);

   --  Read the XML project description into the project description.
   procedure Read_Project (Project : in out Project_Definition);

   --  Scan and read the possible modules used by the application.  Modules are stored in the
   --  modules directory.  Each module is stored in its own directory and has its own
   --  dynamo.xml file.
   procedure Read_Modules (Project  : in out Project_Definition);

   --  ------------------------------
   --  Root Project Definition
   --  ------------------------------
   --  The root project is the project that is actually read by Dynamo.
   --  It contains the lists of all projects that are necessary and which are found either
   --  by scanning GNAT projects or by looking at plugin dependencies.
   type Root_Project_Definition is new Project_Definition with record
      Projects    : Project_Vectors.Vector;

      Install_Dir : Unbounded_String;
   end record;

   --  Add the project in the global project list on the root project instance.
   overriding
   procedure Add_Project (Into    : in out Root_Project_Definition;
                          Project : in Project_Definition_Access);

   --  Find the project definition having the name Name.
   --  Returns null if there is no such project
   overriding
   function Find_Project_By_Name (From : in Root_Project_Definition;
                                  Name : in String) return Project_Definition_Access;

   --  Find the project definition associated with the dynamo XML file Path.
   --  Returns null if there is no such project
   overriding
   function Find_Project (From : in Root_Project_Definition;
                          Path : in String) return Project_Definition_Access;

   --  Read the XML project file.  When Recursive is set, read the GNAT project
   --  files used by the main project and load all the dynamo.xml files defined
   --  by these project.
   procedure Read_Project (Project   : in out Root_Project_Definition;
                           File      : in String;
                           Config    : in Util.Properties.Manager'Class;
                           Recursive : in Boolean := False);

private

   --  Update the project references after a project is found and initialized.
   procedure Update_References (Root    : in out Root_Project_Definition;
                                Project : in Project_Definition_Access);

   --  Iterate over the project referenced in the list and execute the Process procedure.
   procedure Iterate (List    : in out Project_Vectors.Vector;
                      Process : access procedure (Item : in out Project_Reference));

   --  Find a project from the list
   function Find_Project (List : in Project_Vectors.Vector;
                          Name : in String) return Project_Reference;

end Gen.Model.Projects;

-----------------------------------------------------------------------
--  gen-model-projects -- Projects meta data
--  Copyright (C) 2011, 2012, 2013, 2014, 2017, 2018 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.Vectors;

with Util.Beans.Objects;
with Util.Properties;

with Gen.Utils;
with Gen.Utils.GNAT;
package Gen.Model.Projects is

   use Ada.Strings.Unbounded;

   type Project_Definition;
   type Project_Definition_Access is access all Project_Definition'Class;

   type Dependency_Type is (NONE, DIRECT, INDIRECT, BOTH);

   type Project_Reference is record
      Project : Project_Definition_Access := null;
      Name    : Unbounded_String;
      Kind    : Dependency_Type := NONE;
   end record;

   package Project_Vectors is
     new Ada.Containers.Vectors (Element_Type => Project_Reference,
                                 Index_Type   => Natural);

   --  ------------------------------
   --  Project Definition
   --  ------------------------------
   type Project_Definition is new Definition with record
      Path    : Unbounded_String;
      Props   : Util.Properties.Manager;
      Modules : Project_Vectors.Vector;

      --  The root project definition.
      Root          : Project_Definition_Access := null;

      --  The list of plugin names that this plugin or project depends on.
      Dependencies  : Project_Vectors.Vector;

      --  The list of GNAT project files used by the project.
      Project_Files : Gen.Utils.GNAT.Project_Info_Vectors.Vector;

      --  The list of 'dynamo.xml' files used by the project (gathered from GNAT files
      --  and by scanning the 'plugins' directory).
      Dynamo_Files  : Gen.Utils.String_List.Vector;

      --  Whether we did a recursive scan of GNAT project files.
      Recursive_Scan : Boolean := False;

      --  Whether we are doing a recursive operation on the project (prevent from cycles).
      Recursing      : Boolean := False;

      --  Whether we did a recursive scan of Dynamo dependencies.
      Depend_Scan    : Boolean := False;

      --  Whether this project is a plugin.
      Is_Plugin      : Boolean := False;
   end record;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   overriding
   function Get_Value (From : Project_Definition;
                       Name : String) return Util.Beans.Objects.Object;

   --  Get the project name.
   function Get_Project_Name (Project : in Project_Definition) return String;

   --  Get the GNAT project file name.  The default is to use the Dynamo project
   --  name and add the .gpr extension.  The gnat_project configuration
   --  property allows to override this default.
   function Get_GNAT_Project_Name (Project : in Project_Definition) return String;

   --  Get the directory path which holds application modules.
   --  This is controlled by the modules_dir configuration property.
   --  The default is <tt>plugins</tt>.
   --  ------------------------------
   function Get_Module_Dir (Project : in Project_Definition) return String;

   --  Find the dependency for the Name plugin.
   --  Returns a null dependency if the project does not depend on that plugin.
   function Find_Dependency (From : in Project_Definition;
                             Name : in String) return Project_Reference;

   --  Add a dependency to the plugin identified by Name.
   procedure Add_Dependency (Into : in out Project_Definition;
                             Name : in String;
                             Kind : in Dependency_Type);

   --  Add a dependency to the plugin identified by Project.
   procedure Add_Dependency (Into    : in out Project_Definition;
                             Project : in Project_Definition_Access;
                             Kind    : in Dependency_Type);

   --  Create a project definition instance to record a project with the dynamo XML file path.
   procedure Create_Project (Into    : in out Project_Definition;
                             Name    : in String;
                             Path    : in String;
                             Project : out Project_Definition_Access);

   --  Add the project in the global project list on the root project instance.
   procedure Add_Project (Into    : in out Project_Definition;
                          Project : in Project_Definition_Access);

   --  Add the project Name as a module.
   procedure Add_Module (Into : in out Project_Definition;
                         Name : in String);

   --  Add the project represented by Project if it is not already part of the modules.
   procedure Add_Module (Into    : in out Project_Definition;
                         Project : in Project_Definition_Access);

   --  Find the project definition associated with the dynamo XML file Path.
   --  Returns null if there is no such project
   function Find_Project (From : in Project_Definition;
                          Path : in String) return Project_Definition_Access;

   --  Find the project definition having the name Name.
   --  Returns null if there is no such project
   function Find_Project_By_Name (From : in Project_Definition;
                                  Name : in String) return Project_Definition_Access;

   --  Save the project description and parameters.
   procedure Save (Project : in out Project_Definition;
                   Path    : in String);

   --  Read the XML project description into the project description.
   procedure Read_Project (Project : in out Project_Definition);

   --  Scan and read the possible modules used by the application.  Modules are stored in the
   --  modules directory.  Each module is stored in its own directory and has its own
   --  dynamo.xml file.
   procedure Read_Modules (Project  : in out Project_Definition);

   --  Update the project definition from the properties.
   procedure Update_From_Properties (Project : in out Project_Definition);

   --  ------------------------------
   --  Root Project Definition
   --  ------------------------------
   --  The root project is the project that is actually read by Dynamo.
   --  It contains the lists of all projects that are necessary and which are found either
   --  by scanning GNAT projects or by looking at plugin dependencies.
   type Root_Project_Definition is new Project_Definition with record
      Projects    : Project_Vectors.Vector;

      Install_Dir : Unbounded_String;
   end record;

   --  Add the project in the global project list on the root project instance.
   overriding
   procedure Add_Project (Into    : in out Root_Project_Definition;
                          Project : in Project_Definition_Access);

   --  Find the project definition having the name Name.
   --  Returns null if there is no such project
   overriding
   function Find_Project_By_Name (From : in Root_Project_Definition;
                                  Name : in String) return Project_Definition_Access;

   --  Find the project definition associated with the dynamo XML file Path.
   --  Returns null if there is no such project
   overriding
   function Find_Project (From : in Root_Project_Definition;
                          Path : in String) return Project_Definition_Access;

   --  Read the XML project file.  When Recursive is set, read the GNAT project
   --  files used by the main project and load all the dynamo.xml files defined
   --  by these project.
   procedure Read_Project (Project   : in out Root_Project_Definition;
                           File      : in String;
                           Config    : in Util.Properties.Manager'Class;
                           Recursive : in Boolean := False);

private

   --  Update the project references after a project is found and initialized.
   procedure Update_References (Root    : in out Root_Project_Definition;
                                Project : in Project_Definition_Access);

   --  Iterate over the project referenced in the list and execute the Process procedure.
   procedure Iterate (List    : in out Project_Vectors.Vector;
                      Process : access procedure (Item : in out Project_Reference));

   --  Find a project from the list
   function Find_Project (List : in Project_Vectors.Vector;
                          Name : in String) return Project_Reference;

end Gen.Model.Projects;

Declare the Update_From_Properties procedure