-----------------------------------------------------------------------
--  util-strings -- Various String Utility
--  Copyright (C) 2001, 2002, 2003, 2009, 2010, 2011, 2012, 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.Fixed;
with Ada.Strings.Hash;
with Ada.Unchecked_Deallocation;
package body Util.Strings is

   --  ------------------------------
   --  Compute the hash value of the string.
   --  ------------------------------
   function Hash (Key : Name_Access) return Ada.Containers.Hash_Type is
   begin
      return Ada.Strings.Hash (Key.all);
   end Hash;

   --  ------------------------------
   --  Returns true if left and right strings are equivalent.
   --  ------------------------------
   function Equivalent_Keys (Left, Right : Name_Access) return Boolean is
   begin
      if Left = null or Right = null then
         return False;
      end if;
      return Left.all = Right.all;
   end Equivalent_Keys;

   --  ------------------------------
   --  Returns Integer'Image (Value) with the possible space stripped.
   --  ------------------------------
   function Image (Value : in Integer) return String is
      S : constant String := Integer'Image (Value);
   begin
      if S (S'First) = ' ' then
         return S (S'First + 1 .. S'Last);
      else
         return S;
      end if;
   end Image;

   --  ------------------------------
   --  Returns Integer'Image (Value) with the possible space stripped.
   --  ------------------------------
   function Image (Value : in Long_Long_Integer) return String is
      S : constant String := Long_Long_Integer'Image (Value);
   begin
      if S (S'First) = ' ' then
         return S (S'First + 1 .. S'Last);
      else
         return S;
      end if;
   end Image;

   use Util.Concurrent.Counters;

   --  ------------------------------
   --  Create a string reference from a string.
   --  ------------------------------
   function To_String_Ref (S : in String) return String_Ref is
      Str : constant String_Record_Access
        := new String_Record '(Len => S'Length, Str => S, Counter => ONE);
   begin
      return String_Ref '(Ada.Finalization.Controlled with
                          Str => Str);
   end To_String_Ref;

   --  ------------------------------
   --  Create a string reference from an unbounded string.
   --  ------------------------------
   function To_String_Ref (S : in Ada.Strings.Unbounded.Unbounded_String) return String_Ref is
      use Ada.Strings.Unbounded;

      Len : constant Natural := Length (S);
      Str : constant String_Record_Access
        := new String_Record '(Len => Len, Str => To_String (S), Counter => ONE);
   begin
      return String_Ref '(Ada.Finalization.Controlled with
                          Str => Str);
   end To_String_Ref;

   --  ------------------------------
   --  Get the string
   --  ------------------------------
   function To_String (S : in String_Ref) return String is
   begin
      if S.Str = null then
         return "";
      else
         return S.Str.Str;
      end if;
   end To_String;

   --  ------------------------------
   --  Get the string as an unbounded string
   --  ------------------------------
   function To_Unbounded_String (S : in String_Ref)
                                 return Ada.Strings.Unbounded.Unbounded_String is
   begin
      if S.Str = null then
         return Ada.Strings.Unbounded.Null_Unbounded_String;
      else
         return Ada.Strings.Unbounded.To_Unbounded_String (S.Str.Str);
      end if;
   end To_Unbounded_String;

   --  ------------------------------
   --  Compute the hash value of the string reference.
   --  ------------------------------
   function Hash (Key : String_Ref) return Ada.Containers.Hash_Type is
   begin
      if Key.Str = null then
         return 0;
      else
         return Ada.Strings.Hash (Key.Str.Str);
      end if;
   end Hash;

   --  ------------------------------
   --  Returns true if left and right string references are equivalent.
   --  ------------------------------
   function Equivalent_Keys (Left, Right : String_Ref) return Boolean is
   begin
      if Left.Str = Right.Str then
         return True;
      elsif Left.Str = null or Right.Str = null then
         return False;
      else
         return Left.Str.Str = Right.Str.Str;
      end if;
   end Equivalent_Keys;

   function "=" (Left  : in String_Ref;
                 Right : in String) return Boolean is
   begin
      if Left.Str = null then
         return False;
      else
         return Left.Str.Str = Right;
      end if;
   end "=";

   function "=" (Left  : in String_Ref;
                 Right : in Ada.Strings.Unbounded.Unbounded_String) return Boolean is
      use Ada.Strings.Unbounded;
   begin
      if Left.Str = null then
         return Right = Null_Unbounded_String;
      else
         return Right = Left.Str.Str;
      end if;
   end "=";

   --  ------------------------------
   --  Returns the string length.
   --  ------------------------------
   function Length (S : in String_Ref) return Natural is
   begin
      if S.Str = null then
         return 0;
      else
         return S.Str.Len;
      end if;
   end Length;

   --  ------------------------------
   --  Increment the reference counter.
   --  ------------------------------
   overriding
   procedure Adjust (Object : in out String_Ref) is
   begin
      if Object.Str /= null then
         Util.Concurrent.Counters.Increment (Object.Str.Counter);
      end if;
   end Adjust;

   --  ------------------------------
   --  Decrement the reference counter and free the allocated string.
   --  ------------------------------
   overriding
   procedure Finalize (Object : in out String_Ref) is

      procedure Free is
        new Ada.Unchecked_Deallocation (String_Record, String_Record_Access);

      Is_Zero : Boolean;
   begin
      if Object.Str /= null then
         Util.Concurrent.Counters.Decrement (Object.Str.Counter, Is_Zero);
         if Is_Zero then
            Free (Object.Str);
         else
            Object.Str := null;
         end if;
      end if;
   end Finalize;

   --  ------------------------------
   --  Search for the first occurrence of the character in the string
   --  after the from index.  This implementation is 3-times faster than
   --  the Ada.Strings.Fixed version.
   --  Returns the index of the first occurrence or 0.
   --  ------------------------------
   function Index (Source : in String;
                   Char   : in Character;
                   From   : in Natural := 0) return Natural is
      Pos : Natural := From;
   begin
      if Pos < Source'First then
         Pos := Source'First;
      end if;
      for I in Pos .. Source'Last loop
         if Source (I) = Char then
            return I;
         end if;
      end loop;
      return 0;
   end Index;

   --  ------------------------------
   --  Search for the first occurrence of the pattern in the string.
   --  ------------------------------
   function Index (Source  : in String;
                   Pattern : in String;
                   From    : in Positive;
                   Going   : in Ada.Strings.Direction := Ada.Strings.Forward) return Natural is
   begin
      return Ada.Strings.Fixed.Index (Source, Pattern, From, Going);
   end Index;

   --  ------------------------------
   --  Returns True if the source string starts with the given prefix.
   --  ------------------------------
   function Starts_With (Source  : in String;
                         Prefix  : in String) return Boolean is
   begin
      return Source'Length >= Prefix'Length
        and then Source (Source'First .. Source'First + Prefix'Length - 1) = Prefix;
   end Starts_With;

   --  ------------------------------
   --  Returns True if the source string ends with the given suffix.
   --  ------------------------------
   function Ends_With (Source  : in String;
                       Suffix  : in String) return Boolean is
   begin
      return Source'Length >= Suffix'Length
        and then Source (Source'Last - Suffix'Length + 1 .. Source'Last) = Suffix;
   end Ends_With;

   --  ------------------------------
   --  Search for the first occurrence of the character in the string
   --  before the from index and going backward.
   --  This implementation is 3-times faster than the Ada.Strings.Fixed version.
   --  Returns the index of the first occurrence or 0.
   --  ------------------------------
   function Rindex (Source : in String;
                    Ch     : in Character;
                    From   : in Natural := 0) return Natural is
      Pos : Natural := From;
   begin
      if Pos < Source'First then
         Pos := Source'Last;
      end if;
      for I in reverse Source'First .. Pos loop
         if Source (I) = Ch then
            return I;
         end if;
      end loop;
      return 0;
   end Rindex;

end Util.Strings;

-----------------------------------------------------------------------
--  util-strings -- Various String Utility
--  Copyright (C) 2001, 2002, 2003, 2009, 2010, 2011, 2012, 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.Fixed;
with Ada.Strings.Hash;
with Ada.Unchecked_Deallocation;
package body Util.Strings is

   --  ------------------------------
   --  Compute the hash value of the string.
   --  ------------------------------
   function Hash (Key : Name_Access) return Ada.Containers.Hash_Type is
   begin
      return Ada.Strings.Hash (Key.all);
   end Hash;

   --  ------------------------------
   --  Returns true if left and right strings are equivalent.
   --  ------------------------------
   function Equivalent_Keys (Left, Right : Name_Access) return Boolean is
   begin
      if Left = null or Right = null then
         return False;
      end if;
      return Left.all = Right.all;
   end Equivalent_Keys;

   --  ------------------------------
   --  Returns Integer'Image (Value) with the possible space stripped.
   --  ------------------------------
   function Image (Value : in Integer) return String is
      S : constant String := Integer'Image (Value);
   begin
      if S (S'First) = ' ' then
         return S (S'First + 1 .. S'Last);
      else
         return S;
      end if;
   end Image;

   --  ------------------------------
   --  Returns Integer'Image (Value) with the possible space stripped.
   --  ------------------------------
   function Image (Value : in Long_Long_Integer) return String is
      S : constant String := Long_Long_Integer'Image (Value);
   begin
      if S (S'First) = ' ' then
         return S (S'First + 1 .. S'Last);
      else
         return S;
      end if;
   end Image;

   use Util.Concurrent.Counters;

   --  ------------------------------
   --  Create a string reference from a string.
   --  ------------------------------
   function To_String_Ref (S : in String) return String_Ref is
      Str : constant String_Record_Access
        := new String_Record '(Len => S'Length, Str => S, Counter => ONE);
   begin
      return String_Ref '(Ada.Finalization.Controlled with
                          Str => Str);
   end To_String_Ref;

   --  ------------------------------
   --  Create a string reference from an unbounded string.
   --  ------------------------------
   function To_String_Ref (S : in Ada.Strings.Unbounded.Unbounded_String) return String_Ref is
      use Ada.Strings.Unbounded;

      Len : constant Natural := Length (S);
      Str : constant String_Record_Access
        := new String_Record '(Len => Len, Str => To_String (S), Counter => ONE);
   begin
      return String_Ref '(Ada.Finalization.Controlled with
                          Str => Str);
   end To_String_Ref;

   --  ------------------------------
   --  Get the string
   --  ------------------------------
   function To_String (S : in String_Ref) return String is
   begin
      if S.Str = null then
         return "";
      else
         return S.Str.Str;
      end if;
   end To_String;

   --  ------------------------------
   --  Get the string as an unbounded string
   --  ------------------------------
   function To_Unbounded_String (S : in String_Ref)
                                 return Ada.Strings.Unbounded.Unbounded_String is
   begin
      if S.Str = null then
         return Ada.Strings.Unbounded.Null_Unbounded_String;
      else
         return Ada.Strings.Unbounded.To_Unbounded_String (S.Str.Str);
      end if;
   end To_Unbounded_String;

   --  ------------------------------
   --  Compute the hash value of the string reference.
   --  ------------------------------
   function Hash (Key : String_Ref) return Ada.Containers.Hash_Type is
   begin
      if Key.Str = null then
         return 0;
      else
         return Ada.Strings.Hash (Key.Str.Str);
      end if;
   end Hash;

   --  ------------------------------
   --  Returns true if left and right string references are equivalent.
   --  ------------------------------
   function Equivalent_Keys (Left, Right : String_Ref) return Boolean is
   begin
      if Left.Str = Right.Str then
         return True;
      elsif Left.Str = null or Right.Str = null then
         return False;
      else
         return Left.Str.Str = Right.Str.Str;
      end if;
   end Equivalent_Keys;

   function "=" (Left  : in String_Ref;
                 Right : in String) return Boolean is
   begin
      if Left.Str = null then
         return False;
      else
         return Left.Str.Str = Right;
      end if;
   end "=";

   function "=" (Left  : in String_Ref;
                 Right : in Ada.Strings.Unbounded.Unbounded_String) return Boolean is
      use Ada.Strings.Unbounded;
   begin
      if Left.Str = null then
         return Right = Null_Unbounded_String;
      else
         return Right = Left.Str.Str;
      end if;
   end "=";

   --  ------------------------------
   --  Returns the string length.
   --  ------------------------------
   function Length (S : in String_Ref) return Natural is
   begin
      if S.Str = null then
         return 0;
      else
         return S.Str.Len;
      end if;
   end Length;

   --  ------------------------------
   --  Increment the reference counter.
   --  ------------------------------
   overriding
   procedure Adjust (Object : in out String_Ref) is
   begin
      if Object.Str /= null then
         Util.Concurrent.Counters.Increment (Object.Str.Counter);
      end if;
   end Adjust;

   --  ------------------------------
   --  Decrement the reference counter and free the allocated string.
   --  ------------------------------
   overriding
   procedure Finalize (Object : in out String_Ref) is

      procedure Free is
        new Ada.Unchecked_Deallocation (String_Record, String_Record_Access);

      Is_Zero : Boolean;
   begin
      if Object.Str /= null then
         Util.Concurrent.Counters.Decrement (Object.Str.Counter, Is_Zero);
         if Is_Zero then
            Free (Object.Str);
         else
            Object.Str := null;
         end if;
      end if;
   end Finalize;

   --  ------------------------------
   --  Search for the first occurrence of the character in the string
   --  after the from index.  This implementation is 3-times faster than
   --  the Ada.Strings.Fixed version.
   --  Returns the index of the first occurrence or 0.
   --  ------------------------------
   function Index (Source : in String;
                   Char   : in Character;
                   From   : in Natural := 0) return Natural is
      Pos : Natural := From;
   begin
      if Pos < Source'First then
         Pos := Source'First;
      end if;
      for I in Pos .. Source'Last loop
         if Source (I) = Char then
            return I;
         end if;
      end loop;
      return 0;
   end Index;

   --  ------------------------------
   --  Search for the first occurrence of the pattern in the string.
   --  ------------------------------
   function Index (Source  : in String;
                   Pattern : in String;
                   From    : in Positive;
                   Going   : in Ada.Strings.Direction := Ada.Strings.Forward) return Natural is
   begin
      return Ada.Strings.Fixed.Index (Source, Pattern, From, Going);
   end Index;

   --  ------------------------------
   --  Returns True if the source string starts with the given prefix.
   --  ------------------------------
   function Starts_With (Source  : in String;
                         Prefix  : in String) return Boolean is
   begin
      return Source'Length >= Prefix'Length
        and then Source (Source'First .. Source'First + Prefix'Length - 1) = Prefix;
   end Starts_With;

   --  ------------------------------
   --  Returns True if the source string ends with the given suffix.
   --  ------------------------------
   function Ends_With (Source  : in String;
                       Suffix  : in String) return Boolean is
   begin
      return Source'Length >= Suffix'Length
        and then Source (Source'Last - Suffix'Length + 1 .. Source'Last) = Suffix;
   end Ends_With;

   --  ------------------------------
   --  Returns True if the source contains the pattern.
   --  ------------------------------
   function Contains (Source  : in String;
                      Pattern : in String) return Boolean is
   begin
      return Ada.Strings.Fixed.Index (Source, Pattern) /= 0;
   end Contains;

   --  ------------------------------
   --  Search for the first occurrence of the character in the string
   --  before the from index and going backward.
   --  This implementation is 3-times faster than the Ada.Strings.Fixed version.
   --  Returns the index of the first occurrence or 0.
   --  ------------------------------
   function Rindex (Source : in String;
                    Ch     : in Character;
                    From   : in Natural := 0) return Natural is
      Pos : Natural := From;
   begin
      if Pos < Source'First then
         Pos := Source'Last;
      end if;
      for I in reverse Source'First .. Pos loop
         if Source (I) = Ch then
            return I;
         end if;
      end loop;
      return 0;
   end Rindex;

end Util.Strings;

Implement the Contains function

Implement the Contains function


with AdaBase.Results.Sets;
with Connect;
with CommonText;
with Ada.Text_IO;

procedure Iterate is

   package CON renames Connect;
   package TIO renames Ada.Text_IO;
   package AR  renames AdaBase.Results;
   package CT  renames CommonText;

   fruit    : aliased AR.textual;
   color    : aliased AR.textual;
   calories : aliased AR.nbyte2;
   dashes   : String (1 .. 50) := (others => '=');

   procedure list_fruit;
   procedure list_hockey_teams (row : AR.Sets.DataRow_Access);

   procedure list_fruit
   is
      pair : String := CT.USS (fruit) & " (" & CT.USS (color) & ")";
      plen : Natural := pair'Length;
      zone : String (1 .. 20) := (others => ' ');
   begin
      zone (1 .. plen) := pair;
      TIO.Put_Line (zone & " contains" & calories'Img & " calories");
   end list_fruit;

   procedure list_hockey_teams (row : AR.Sets.DataRow_Access) is
   begin
      TIO.Put_Line (row.column ("city").as_string & " " &
                    row.column ("mascot").as_string & " (" &
                    row.column ("abbreviation").as_string & ")");
   end list_hockey_teams;

begin

   begin
      CON.connect_database;
   exception
      when others =>
         TIO.Put_Line ("database connect failed.");
         return;
   end;

   begin
      CON.STMT := CON.DR.query_select
                  (tables    => "fruits",
                  columns    => "fruit, calories, color",
                  conditions => "calories >= 50",
                  order      => "calories");

      CON.STMT.bind ("fruit",    fruit'Unchecked_Access);
      CON.STMT.bind ("calories", calories'Unchecked_Access);
      CON.STMT.bind ("color",    color'Unchecked_Access);

      TIO.Put_Line ("Demonstrate STMT.iterate (query + bound variables)");
      TIO.Put_Line (dashes);
      TIO.Put_Line ("List of fruit the contain at least 50 calories");
      TIO.Put_Line (dashes);
      CON.STMT.iterate (process => list_fruit'Access);
   end;

   begin
      CON.STMT := CON.DR.prepare_select
                  (tables    => "nhl_teams",
                  columns    => "*",
                  conditions => "city LIKE :pattern",
                  order      => "city");

      TIO.Put_Line ("");
      TIO.Put_Line ("Demonstrate STMT.iterate (prepare + data access)");
      TIO.Put_Line (dashes);
      TIO.Put_Line ("List of NHL teams in locations starting with 'C'");
      TIO.Put_Line (dashes);

      CON.STMT.assign ("pattern", "C%");
      if CON.STMT.execute then
         CON.STMT.iterate (process => list_hockey_teams'Access);
      end if;
   end;

   CON.DR.disconnect;

end Iterate;

with AdaBase.Results.Sets;
with Connect;
with CommonText;
with Ada.Text_IO;

procedure Iterate is

   package CON renames Connect;
   package TIO renames Ada.Text_IO;
   package AR  renames AdaBase.Results;
   package CT  renames CommonText;

   fruit    : aliased AR.textual;
   color    : aliased AR.textual;
   calories : aliased AR.nbyte2;
   dashes   : String (1 .. 50) := (others => '=');

   procedure list_fruit;
   procedure list_hockey_teams (row : AR.Sets.DataRow);

   procedure list_fruit
   is
      pair : String := CT.USS (fruit) & " (" & CT.USS (color) & ")";
      plen : Natural := pair'Length;
      zone : String (1 .. 20) := (others => ' ');
   begin
      zone (1 .. plen) := pair;
      TIO.Put_Line (zone & " contains" & calories'Img & " calories");
   end list_fruit;

   procedure list_hockey_teams (row : AR.Sets.DataRow) is
   begin
      TIO.Put_Line (row.column ("city").as_string & " " &
                    row.column ("mascot").as_string & " (" &
                    row.column ("abbreviation").as_string & ")");
   end list_hockey_teams;

begin

   begin
      CON.connect_database;
   exception
      when others =>
         TIO.Put_Line ("database connect failed.");
         return;
   end;

   declare
      stmt : CON.Stmt_Type := CON.DR.query_select
                  (tables    => "fruits",
                  columns    => "fruit, calories, color",
                  conditions => "calories >= 50",
                  order      => "calories");
   begin
      stmt.bind ("fruit",    fruit'Unchecked_Access);
      stmt.bind ("calories", calories'Unchecked_Access);
      stmt.bind ("color",    color'Unchecked_Access);

      TIO.Put_Line ("Demonstrate STMT.iterate (query + bound variables)");
      TIO.Put_Line (dashes);
      TIO.Put_Line ("List of fruit the contain at least 50 calories");
      TIO.Put_Line (dashes);
      stmt.iterate (process => list_fruit'Access);
   end;

   declare
      stmt : CON.Stmt_Type := CON.DR.prepare_select
                  (tables    => "nhl_teams",
                  columns    => "*",
                  conditions => "city LIKE :pattern",
                  order      => "city");
   begin
      TIO.Put_Line ("");
      TIO.Put_Line ("Demonstrate STMT.iterate (prepare + data access)");
      TIO.Put_Line (dashes);
      TIO.Put_Line ("List of NHL teams in locations starting with 'C'");
      TIO.Put_Line (dashes);

      stmt.assign ("pattern", "C%");
      if stmt.execute then
         stmt.iterate (process => list_hockey_teams'Access);
      end if;
   end;

   CON.DR.disconnect;

end Iterate;

fix iterate test case

fix iterate test case


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

with Ada.Unchecked_Deallocation;

with AWS.SMTP.Client;

with Util.Log.Loggers;

package body AWA.Mail.Clients.AWS_SMTP is

   use Ada.Strings.Unbounded;

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Mail.Clients.AWS_SMTP");

   procedure Free is
      new Ada.Unchecked_Deallocation (Object => AWS.SMTP.Recipients,
                                      Name   => Recipients_Access);

   --  Get a printable representation of the email recipients.
   function Image (Recipients : in AWS.SMTP.Recipients) return String;

   --  ------------------------------
   --  Set the <tt>From</tt> part of the message.
   --  ------------------------------
   overriding
   procedure Set_From (Message : in out AWS_Mail_Message;
                       Name    : in String;
                       Address : in String) is
   begin
      Message.From := AWS.SMTP.E_Mail (Name    => Name,
                                       Address => Address);
   end Set_From;

   --  ------------------------------
   --  Add a recipient for the message.
   --  ------------------------------
   overriding
   procedure Add_Recipient (Message : in out AWS_Mail_Message;
                            Kind    : in Recipient_Type;
                            Name    : in String;
                            Address : in String) is
      pragma Unreferenced (Kind);
   begin
      if Message.To = null then
         Message.To := new AWS.SMTP.Recipients (1 .. 1);
      else
         declare
            To : constant Recipients_Access := new AWS.SMTP.Recipients (1 .. Message.To'Last + 1);
         begin
            To (Message.To'Range) := Message.To.all;
            Free (Message.To);
            Message.To := To;
         end;
      end if;
      Message.To (Message.To'Last) := AWS.SMTP.E_Mail (Name    => Name,
                                                       Address => Address);
   end Add_Recipient;

   --  ------------------------------
   --  Set the subject of the message.
   --  ------------------------------
   overriding
   procedure Set_Subject (Message : in out AWS_Mail_Message;
                          Subject : in String) is
   begin
      Message.Subject := To_Unbounded_String (Subject);
   end Set_Subject;

   --  ------------------------------
   --  Set the body of the message.
   --  ------------------------------
   overriding
   procedure Set_Body (Message : in out AWS_Mail_Message;
                       Content : in String) is
   begin
      Message.Content := To_Unbounded_String (Content);
   end Set_Body;

   --  ------------------------------
   --  Get a printable representation of the email recipients.
   --  ------------------------------
   function Image (Recipients : in AWS.SMTP.Recipients) return String is
      Result : Unbounded_String;
   begin
      for I in Recipients'Range loop
         Append (Result, AWS.SMTP.Image (Recipients (I)));
      end loop;
      return To_String (Result);
   end Image;

   --  ------------------------------
   --  Send the email message.
   --  ------------------------------
   overriding
   procedure Send (Message : in out AWS_Mail_Message) is
      Result  : AWS.SMTP.Status;
   begin
      if Message.To = null then
         return;
      end if;

      if Message.Manager.Enable then
         Log.Info ("Send email from {0} to {1}",
                   AWS.SMTP.Image (Message.From), Image (Message.To.all));
         AWS.SMTP.Client.Send (Server  => Message.Manager.Server,
                               From    => Message.From,
                               To      => Message.To.all,
                               Subject => To_String (Message.Subject),
                               Message => To_String (Message.Content),
                               Status  => Result);

      else
         Log.Info ("Disable send email to {0}", "");
      end if;
   end Send;

   --  ------------------------------
   --  Deletes the mail message.
   --  ------------------------------
   overriding
   procedure Finalize (Message : in out AWS_Mail_Message) is
   begin
      Log.Info ("Finalize mail message");
      Free (Message.To);
   end Finalize;

   --  ------------------------------
   --  Create a SMTP based mail manager and configure it according to the properties.
   --  ------------------------------
   function Create_Manager (Props : in Util.Properties.Manager'Class) return Mail_Manager_Access is
      Server : constant String := Props.Get (Name => "smtp.host", Default => "localhost");
      Port   : constant String := Props.Get (Name => "smtp.port", Default => "25");
      Enable : constant String := Props.Get (Name => "smtp.enable", Default => "1");
      Result : constant AWS_Mail_Manager_Access := new AWS_Mail_Manager;
   begin
      Log.Info ("Creating SMTP mail manager to server {0}:{1}", Server, Port);

      Result.Self   := Result;
      Result.Enable := Enable = "1" or Enable = "yes" or Enable = "true";
      Result.Server := AWS.SMTP.Client.Initialize (Server_Name => Server,
                                                   Port => Positive'Value (Port));
      return Result.all'Access;
   end Create_Manager;

   --  ------------------------------
   --  Create a new mail message.
   --  ------------------------------
   overriding
   function Create_Message (Manager : in AWS_Mail_Manager) return Mail_Message_Access is
      Result : constant AWS_Mail_Message_Access := new AWS_Mail_Message;
   begin
      Result.Manager := Manager.Self;
      return Result.all'Access;
   end Create_Message;

end AWA.Mail.Clients.AWS_SMTP;

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

with Ada.Unchecked_Deallocation;

with AWS.SMTP.Client;

with Util.Log.Loggers;

package body AWA.Mail.Clients.AWS_SMTP is

   use Ada.Strings.Unbounded;

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Mail.Clients.AWS_SMTP");

   procedure Free is
      new Ada.Unchecked_Deallocation (Object => AWS.SMTP.Recipients,
                                      Name   => Recipients_Access);

   --  Get a printable representation of the email recipients.
   function Image (Recipients : in AWS.SMTP.Recipients) return String;

   --  ------------------------------
   --  Set the <tt>From</tt> part of the message.
   --  ------------------------------
   overriding
   procedure Set_From (Message : in out AWS_Mail_Message;
                       Name    : in String;
                       Address : in String) is
   begin
      Message.From := AWS.SMTP.E_Mail (Name    => Name,
                                       Address => Address);
   end Set_From;

   --  ------------------------------
   --  Add a recipient for the message.
   --  ------------------------------
   overriding
   procedure Add_Recipient (Message : in out AWS_Mail_Message;
                            Kind    : in Recipient_Type;
                            Name    : in String;
                            Address : in String) is
      pragma Unreferenced (Kind);
   begin
      if Message.To = null then
         Message.To := new AWS.SMTP.Recipients (1 .. 1);
      else
         declare
            To : constant Recipients_Access := new AWS.SMTP.Recipients (1 .. Message.To'Last + 1);
         begin
            To (Message.To'Range) := Message.To.all;
            Free (Message.To);
            Message.To := To;
         end;
      end if;
      Message.To (Message.To'Last) := AWS.SMTP.E_Mail (Name    => Name,
                                                       Address => Address);
   end Add_Recipient;

   --  ------------------------------
   --  Set the subject of the message.
   --  ------------------------------
   overriding
   procedure Set_Subject (Message : in out AWS_Mail_Message;
                          Subject : in String) is
   begin
      Message.Subject := To_Unbounded_String (Subject);
   end Set_Subject;

   --  ------------------------------
   --  Set the body of the message.
   --  ------------------------------
   overriding
   procedure Set_Body (Message : in out AWS_Mail_Message;
                       Content : in String) is
   begin
      Message.Content := To_Unbounded_String (Content);
   end Set_Body;

   --  ------------------------------
   --  Get a printable representation of the email recipients.
   --  ------------------------------
   function Image (Recipients : in AWS.SMTP.Recipients) return String is
      Result : Unbounded_String;
   begin
      for I in Recipients'Range loop
         Append (Result, AWS.SMTP.Image (Recipients (I)));
      end loop;
      return To_String (Result);
   end Image;

   --  ------------------------------
   --  Send the email message.
   --  ------------------------------
   overriding
   procedure Send (Message : in out AWS_Mail_Message) is
      Result  : AWS.SMTP.Status;
   begin
      if Message.To = null then
         return;
      end if;

      if Message.Manager.Enable then
         Log.Info ("Send email from {0} to {1}",
                   AWS.SMTP.Image (Message.From), Image (Message.To.all));
         AWS.SMTP.Client.Send (Server  => Message.Manager.Server,
                               From    => Message.From,
                               To      => Message.To.all,
                               Subject => To_String (Message.Subject),
                               Message => To_String (Message.Content),
                               Status  => Result);

      else
         Log.Info ("Disable send email from {0} to {1}",
                   AWS.SMTP.Image (Message.From), Image (Message.To.all));
      end if;
   end Send;

   --  ------------------------------
   --  Deletes the mail message.
   --  ------------------------------
   overriding
   procedure Finalize (Message : in out AWS_Mail_Message) is
   begin
      Log.Info ("Finalize mail message");
      Free (Message.To);
   end Finalize;

   --  ------------------------------
   --  Create a SMTP based mail manager and configure it according to the properties.
   --  ------------------------------
   function Create_Manager (Props : in Util.Properties.Manager'Class) return Mail_Manager_Access is
      Server : constant String := Props.Get (Name => "smtp.host", Default => "localhost");
      Port   : constant String := Props.Get (Name => "smtp.port", Default => "25");
      Enable : constant String := Props.Get (Name => "smtp.enable", Default => "1");
      Result : constant AWS_Mail_Manager_Access := new AWS_Mail_Manager;
   begin
      Log.Info ("Creating SMTP mail manager to server {0}:{1}", Server, Port);

      Result.Self   := Result;
      Result.Enable := Enable = "1" or Enable = "yes" or Enable = "true";
      Result.Server := AWS.SMTP.Client.Initialize (Server_Name => Server,
                                                   Port => Positive'Value (Port));
      return Result.all'Access;
   end Create_Manager;

   --  ------------------------------
   --  Create a new mail message.
   --  ------------------------------
   overriding
   function Create_Message (Manager : in AWS_Mail_Manager) return Mail_Message_Access is
      Result : constant AWS_Mail_Message_Access := new AWS_Mail_Message;
   begin
      Result.Manager := Manager.Self;
      return Result.all'Access;
   end Create_Message;

end AWA.Mail.Clients.AWS_SMTP;

Update the log if the mail is disabled

Update the log if the mail is disabled


-----------------------------------------------------------------------
--  util-commands-parsers.gnat_parser -- GNAT command line parser for command drivers
--  Copyright (C) 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 GNAT.OS_Lib;

package body Util.Commands.Parsers.GNAT_Parser is

   function To_OS_Lib_Argument_List (Args : in Argument_List'Class)
                                     return GNAT.OS_Lib.Argument_List_Access;

   function To_OS_Lib_Argument_List (Args : in Argument_List'Class)
                                     return GNAT.OS_Lib.Argument_List_Access is
      Count   : constant Natural := Args.Get_Count;
      New_Arg : GNAT.OS_Lib.Argument_List (1 .. Count);
   begin
      for I in 1 .. Count loop
         New_Arg (I) := new String '(Args.Get_Argument (I));
      end loop;
      return new GNAT.OS_Lib.Argument_List '(New_Arg);
   end To_OS_Lib_Argument_List;

   procedure Execute (Config : in out Config_Type;
                      Args   : in Util.Commands.Argument_List'Class;
                      Process : access procedure (Cmd_Args : in Commands.Argument_List'Class)) is
      use type GNAT.Command_Line.Command_Line_Configuration;

      Empty    : Config_Type;
    begin
      if Config /= Empty then
         declare
            Parser   : GNAT.Command_Line.Opt_Parser;
            Cmd_Args : Dynamic_Argument_List;
            Params   : GNAT.OS_Lib.Argument_List_Access
              := To_OS_Lib_Argument_List (Args);
         begin
            GNAT.Command_Line.Initialize_Option_Scan (Parser, Params);
            GNAT.Command_Line.Getopt (Config => Config, Parser => Parser);
            loop
               declare
                  S : constant String := GNAT.Command_Line.Get_Argument (Parser => Parser);
               begin
                  exit when S'Length = 0;
                  Cmd_Args.List.Append (S);
               end;
            end loop;
            Process (Cmd_Args);
            GNAT.OS_Lib.Free (Params);

         exception
            when others =>
               GNAT.OS_Lib.Free (Params);
               raise;
         end;
      else
         Process (Args);
      end if;
   end Execute;

end Util.Commands.Parsers.GNAT_Parser;

-----------------------------------------------------------------------
--  util-commands-parsers.gnat_parser -- GNAT command line parser for command drivers
--  Copyright (C) 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 GNAT.OS_Lib;

package body Util.Commands.Parsers.GNAT_Parser is

   function To_OS_Lib_Argument_List (Args : in Argument_List'Class)
                                     return GNAT.OS_Lib.Argument_List_Access;

   function To_OS_Lib_Argument_List (Args : in Argument_List'Class)
                                     return GNAT.OS_Lib.Argument_List_Access is
      Count   : constant Natural := Args.Get_Count;
      New_Arg : GNAT.OS_Lib.Argument_List (1 .. Count);
   begin
      for I in 1 .. Count loop
         New_Arg (I) := new String '(Args.Get_Argument (I));
      end loop;
      return new GNAT.OS_Lib.Argument_List '(New_Arg);
   end To_OS_Lib_Argument_List;

   procedure Execute (Config : in out Config_Type;
                      Args   : in Util.Commands.Argument_List'Class;
                      Process : access procedure (Cmd_Args : in Commands.Argument_List'Class)) is
      use type GNAT.Command_Line.Command_Line_Configuration;

      Empty    : Config_Type;
   begin
      if Config /= Empty then
         declare
            Parser   : GNAT.Command_Line.Opt_Parser;
            Cmd_Args : Dynamic_Argument_List;
            Params   : GNAT.OS_Lib.Argument_List_Access
              := To_OS_Lib_Argument_List (Args);
         begin
            GNAT.Command_Line.Initialize_Option_Scan (Parser, Params);
            GNAT.Command_Line.Getopt (Config => Config, Parser => Parser);
            loop
               declare
                  S : constant String := GNAT.Command_Line.Get_Argument (Parser => Parser);
               begin
                  exit when S'Length = 0;
                  Cmd_Args.List.Append (S);
               end;
            end loop;
            Process (Cmd_Args);
            GNAT.OS_Lib.Free (Params);

         exception
            when others =>
               GNAT.OS_Lib.Free (Params);
               raise;
         end;
      else
         Process (Args);
      end if;
   end Execute;

   procedure Usage (Name   : in String;
                    Config : in out Config_Type) is
   begin
      GNAT.Command_Line.Set_Usage (Config, Usage => Name & " [switches] [arguments]");
      GNAT.Command_Line.Display_Help (Config);
   end Usage;

end Util.Commands.Parsers.GNAT_Parser;

Implement Usage procedure to report the command usage


-----------------------------------------------------------------------
--  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 Util.Log.Loggers;

with MAT.Memory.Readers;
package body MAT.Memory.Targets is

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("MAT.Memory.Targets");

   --  ------------------------------
   --  Initialize the target memory object to manage the memory slots, the stack frames
   --  and setup the reader to analyze the memory events.
   --  ------------------------------
   procedure Initialize (Memory : in out Target_Memory;
                         Reader : in out MAT.Readers.Manager_Base'Class) is
      Memory_Reader : constant MAT.Memory.Readers.Memory_Reader_Access
        := new MAT.Memory.Readers.Memory_Servant;
   begin
      Memory.Reader := Memory_Reader.all'Access;
      Memory_Reader.Data := Memory'Unrestricted_Access;
      MAT.Memory.Readers.Register (Reader, Memory_Reader);
   end Initialize;

   --  ------------------------------
   --  Take into account a malloc probe.  The memory slot [Addr .. Slot.Size] is inserted
   --  in the used slots map.  The freed slots that intersect the malloc'ed region are
   --  removed from the freed map.
   --  ------------------------------
   procedure Probe_Malloc (Memory : in out Target_Memory;
                           Addr   : in MAT.Types.Target_Addr;
                           Slot   : in Allocation) is
   begin
      Memory.Memory.Probe_Malloc (Addr, Slot);
   end Probe_Malloc;

   --  ------------------------------
   --  Take into account a free probe.  Add the memory slot in the freed map and remove
   --  the slot from the used slots map.
   --  ------------------------------
   procedure Probe_Free (Memory : in out Target_Memory;
                         Addr   : in MAT.Types.Target_Addr;
                         Slot   : in Allocation) is
   begin
      Memory.Memory.Probe_Free (Addr, Slot);
   end Probe_Free;

   --  ------------------------------
   --  Take into account a realloc probe.  The old memory slot represented by Old_Addr is
   --  removed from the used slots maps and the new memory slot [Addr .. Slot.Size] is
   --  inserted in the used slots map.
   --  ------------------------------
   procedure Probe_Realloc (Memory : in out Target_Memory;
                            Addr     : in MAT.Types.Target_Addr;
                            Old_Addr : in MAT.Types.Target_Addr;
                            Slot     : in Allocation) is
   begin
      Memory.Memory.Probe_Realloc (Addr, Old_Addr, Slot);
   end Probe_Realloc;

   --  ------------------------------
   --  Insert in the frame tree the new stack frame represented by <tt>Pc</tt>.
   --  If the frame is already known, the frame reference counter is incremented.
   --  The frame represented by <tt>Pc</tt> is returned in <tt>Result</tt>.
   --  ------------------------------
   procedure Create_Frame (Memory : in out Target_Memory;
                           Pc     : in MAT.Frames.Frame_Table;
                           Result : out MAT.Frames.Frame_Type) is
   begin
      Memory.Memory.Create_Frame (Pc, Result);
   end Create_Frame;

   --  ------------------------------
   --  Collect the information about memory slot sizes allocated by the application.
   --  ------------------------------
   procedure Size_Information (Memory : in out Target_Memory;
                               Sizes  : in out MAT.Memory.Tools.Size_Info_Map) is
   begin
      Memory.Memory.Size_Information (Sizes);
   end Size_Information;

   --  ------------------------------
   --  Collect the information about threads and the memory allocations they've made.
   --  ------------------------------
   procedure Thread_Information (Memory  : in out Target_Memory;
                                 Threads : in out Memory_Info_Map) is
   begin
      Memory.Memory.Thread_Information (Threads);
   end Thread_Information;

   --  ------------------------------
   --  Find from the memory 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 out Target_Memory;
                   From   : in MAT.Types.Target_Addr;
                   To     : in MAT.Types.Target_Addr;
                   Into   : in out MAT.Memory.Allocation_Map) is
   begin
      Memory.Memory.Find (From, To, Into);
   end Find;

   protected body Memory_Allocator is

      --  ------------------------------
      --  Remove the memory region [Addr .. Addr + Size] from the free list.
      --  ------------------------------
      procedure Remove_Free (Addr : in MAT.Types.Target_Addr;
                             Size : in MAT.Types.Target_Size) is
         Iter : Allocation_Cursor;
         Last : constant MAT.Types.Target_Addr := Addr + MAT.Types.Target_Addr (Size);
         Slot : Allocation;
      begin
         --  Walk the list of free blocks and remove all the blocks which intersect the region
         --  [Addr .. Addr + Slot.Size].  We start walking at the first block below and near
         --  the address.  Slots are then removed when they intersect the malloc'ed region.
         Iter := Freed_Slots.Floor (Addr);
         while Allocation_Maps.Has_Element (Iter) loop
            declare
               Freed_Addr : constant MAT.Types.Target_Addr := Allocation_Maps.Key (Iter);
            begin
               exit when Freed_Addr > Last;
               Slot := Allocation_Maps.Element (Iter);
               if Freed_Addr + MAT.Types.Target_Addr (Slot.Size) > Addr then
                  Freed_Slots.Delete (Iter);
                  Iter := Freed_Slots.Floor (Addr);
               else
                  Allocation_Maps.Next (Iter);
               end if;
            end;
         end loop;
      end Remove_Free;

      --  ------------------------------
      --  Take into account a malloc probe.  The memory slot [Addr .. Slot.Size] is inserted
      --  in the used slots map.  The freed slots that intersect the malloc'ed region are
      --  removed from the freed map.
      --  ------------------------------
      procedure Probe_Malloc (Addr   : in MAT.Types.Target_Addr;
                              Slot   : in Allocation) is
      begin
         if Log.Get_Level = Util.Log.DEBUG_LEVEL then
            Log.Debug ("Malloc at {0} size {1}", MAT.Types.Hex_Image (Addr),
                       MAT.Types.Target_Size'Image (Slot.Size));
         end if;
         Remove_Free (Addr, Slot.Size);
         Used_Slots.Insert (Addr, Slot);
      end Probe_Malloc;

      --  ------------------------------
      --  Take into account a free probe.  Add the memory slot in the freed map and remove
      --  the slot from the used slots map.
      --  ------------------------------
      procedure Probe_Free (Addr   : in MAT.Types.Target_Addr;
                            Slot   : in Allocation) is
         Item : Allocation;
         Iter : Allocation_Cursor;
      begin
         if Log.Get_Level = Util.Log.DEBUG_LEVEL then
            Log.Debug ("Free {0}", MAT.Types.Hex_Image (Addr));
         end if;
         Iter := Used_Slots.Find (Addr);
         if Allocation_Maps.Has_Element (Iter) then
            Item := Allocation_Maps.Element (Iter);
            MAT.Frames.Release (Item.Frame);
            Used_Slots.Delete (Iter);
            Item.Frame := Slot.Frame;
            Freed_Slots.Insert (Addr, Item);
         end if;
      end Probe_Free;

      --  ------------------------------
      --  Take into account a realloc probe.  The old memory slot represented by Old_Addr is
      --  removed from the used slots maps and the new memory slot [Addr .. Slot.Size] is
      --  inserted in the used slots map.
      --  ------------------------------
      procedure Probe_Realloc (Addr     : in MAT.Types.Target_Addr;
                               Old_Addr : in MAT.Types.Target_Addr;
                               Slot     : in Allocation) is
         procedure Update_Size (Key     : in MAT.Types.Target_Addr;
                                Element : in out Allocation);

         procedure Update_Size (Key     : in MAT.Types.Target_Addr;
                                Element : in out Allocation) is
            pragma Unreferenced (Key);
         begin
            Element.Size := Slot.Size;
            MAT.Frames.Release (Element.Frame);
            Element.Frame := Slot.Frame;
         end Update_Size;

         Pos      : Allocation_Cursor;
      begin
         if Log.Get_Level = Util.Log.DEBUG_LEVEL then
            Log.Debug ("Realloc {0} to {1} size {2}", MAT.Types.Hex_Image (Old_Addr),
                       MAT.Types.Hex_Image (Addr), MAT.Types.Target_Size'Image (Slot.Size));
         end if;
         if Addr /= 0 then
            Pos := Used_Slots.Find (Old_Addr);
            if Allocation_Maps.Has_Element (Pos) then
               if Addr = Old_Addr then
                  Used_Slots.Update_Element (Pos, Update_Size'Access);
               else
                  Used_Slots.Delete (Pos);
                  Used_Slots.Insert (Addr, Slot);
               end if;
            else
               Used_Slots.Insert (Addr, Slot);
            end if;
            Remove_Free (Addr, Slot.Size);
         end if;
      end Probe_Realloc;

      --  ------------------------------
      --  Insert in the frame tree the new stack frame represented by <tt>Pc</tt>.
      --  If the frame is already known, the frame reference counter is incremented.
      --  The frame represented by <tt>Pc</tt> is returned in <tt>Result</tt>.
      --  ------------------------------
      procedure Create_Frame (Pc     : in MAT.Frames.Frame_Table;
                              Result : out MAT.Frames.Frame_Type) is
      begin
         MAT.Frames.Insert (Frames, Pc, Result);
      end Create_Frame;

      --  ------------------------------
      --  Collect the information about memory slot sizes allocated by the application.
      --  ------------------------------
      procedure Size_Information (Sizes  : in out MAT.Memory.Tools.Size_Info_Map) is
      begin
         MAT.Memory.Tools.Size_Information (Used_Slots, Sizes);
      end Size_Information;

      --  ------------------------------
      --  Collect the information about threads and the memory allocations they've made.
      --  ------------------------------
      procedure Thread_Information (Threads : in out Memory_Info_Map) is
      begin
         MAT.Memory.Tools.Thread_Information (Used_Slots, Threads);
      end Thread_Information;

      --  ------------------------------
      --  Find from the memory 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 (From   : in MAT.Types.Target_Addr;
                      To     : in MAT.Types.Target_Addr;
                      Into   : in out MAT.Memory.Allocation_Map) is
      begin
         MAT.Memory.Tools.Find (Used_Slots, From, To, Into);
      end Find;

   end Memory_Allocator;

end MAT.Memory.Targets;

-----------------------------------------------------------------------
--  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 Util.Log.Loggers;

with MAT.Memory.Readers;
package body MAT.Memory.Targets is

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("MAT.Memory.Targets");

   --  ------------------------------
   --  Initialize the target memory object to manage the memory slots, the stack frames
   --  and setup the reader to analyze the memory events.
   --  ------------------------------
   procedure Initialize (Memory : in out Target_Memory;
                         Reader : in out MAT.Readers.Manager_Base'Class) is
      Memory_Reader : constant MAT.Memory.Readers.Memory_Reader_Access
        := new MAT.Memory.Readers.Memory_Servant;
   begin
      Memory.Reader := Memory_Reader.all'Access;
      Memory_Reader.Data := Memory'Unrestricted_Access;
      MAT.Memory.Readers.Register (Reader, Memory_Reader);
   end Initialize;

   --  ------------------------------
   --  Take into account a malloc probe.  The memory slot [Addr .. Slot.Size] is inserted
   --  in the used slots map.  The freed slots that intersect the malloc'ed region are
   --  removed from the freed map.
   --  ------------------------------
   procedure Probe_Malloc (Memory : in out Target_Memory;
                           Addr   : in MAT.Types.Target_Addr;
                           Slot   : in Allocation) is
   begin
      Memory.Memory.Probe_Malloc (Addr, Slot);
   end Probe_Malloc;

   --  ------------------------------
   --  Take into account a free probe.  Add the memory slot in the freed map and remove
   --  the slot from the used slots map.
   --  ------------------------------
   procedure Probe_Free (Memory : in out Target_Memory;
                         Addr   : in MAT.Types.Target_Addr;
                         Slot   : in Allocation) is
   begin
      Memory.Memory.Probe_Free (Addr, Slot);
   end Probe_Free;

   --  ------------------------------
   --  Take into account a realloc probe.  The old memory slot represented by Old_Addr is
   --  removed from the used slots maps and the new memory slot [Addr .. Slot.Size] is
   --  inserted in the used slots map.
   --  ------------------------------
   procedure Probe_Realloc (Memory : in out Target_Memory;
                            Addr     : in MAT.Types.Target_Addr;
                            Old_Addr : in MAT.Types.Target_Addr;
                            Slot     : in Allocation) is
   begin
      Memory.Memory.Probe_Realloc (Addr, Old_Addr, Slot);
   end Probe_Realloc;

   --  ------------------------------
   --  Insert in the frame tree the new stack frame represented by <tt>Pc</tt>.
   --  If the frame is already known, the frame reference counter is incremented.
   --  The frame represented by <tt>Pc</tt> is returned in <tt>Result</tt>.
   --  ------------------------------
   procedure Create_Frame (Memory : in out Target_Memory;
                           Pc     : in MAT.Frames.Frame_Table;
                           Result : out MAT.Frames.Frame_Type) is
   begin
      Memory.Memory.Create_Frame (Pc, Result);
   end Create_Frame;

   --  ------------------------------
   --  Collect the information about memory slot sizes allocated by the application.
   --  ------------------------------
   procedure Size_Information (Memory : in out Target_Memory;
                               Sizes  : in out MAT.Memory.Tools.Size_Info_Map) is
   begin
      Memory.Memory.Size_Information (Sizes);
   end Size_Information;

   --  ------------------------------
   --  Collect the information about threads and the memory allocations they've made.
   --  ------------------------------
   procedure Thread_Information (Memory  : in out Target_Memory;
                                 Threads : in out Memory_Info_Map) is
   begin
      Memory.Memory.Thread_Information (Threads);
   end Thread_Information;

   --  ------------------------------
   --  Find from the <tt>Memory</tt> map the memory slots whose address intersects
   --  the region [From .. To] and which is selected by the given filter expression.
   --  Add the memory slot in the <tt>Into</tt> list if it does not already contains
   --  the memory slot.
   --  ------------------------------
   procedure Find (Memory : in out Target_Memory;
                   From   : in MAT.Types.Target_Addr;
                   To     : in MAT.Types.Target_Addr;
                   Filter : in MAT.Expressions.Expression_Type;
                   Into   : in out MAT.Memory.Allocation_Map) is
   begin
      Memory.Memory.Find (From, To, Filter, Into);
   end Find;

   protected body Memory_Allocator is

      --  ------------------------------
      --  Remove the memory region [Addr .. Addr + Size] from the free list.
      --  ------------------------------
      procedure Remove_Free (Addr : in MAT.Types.Target_Addr;
                             Size : in MAT.Types.Target_Size) is
         Iter : Allocation_Cursor;
         Last : constant MAT.Types.Target_Addr := Addr + MAT.Types.Target_Addr (Size);
         Slot : Allocation;
      begin
         --  Walk the list of free blocks and remove all the blocks which intersect the region
         --  [Addr .. Addr + Slot.Size].  We start walking at the first block below and near
         --  the address.  Slots are then removed when they intersect the malloc'ed region.
         Iter := Freed_Slots.Floor (Addr);
         while Allocation_Maps.Has_Element (Iter) loop
            declare
               Freed_Addr : constant MAT.Types.Target_Addr := Allocation_Maps.Key (Iter);
            begin
               exit when Freed_Addr > Last;
               Slot := Allocation_Maps.Element (Iter);
               if Freed_Addr + MAT.Types.Target_Addr (Slot.Size) > Addr then
                  Freed_Slots.Delete (Iter);
                  Iter := Freed_Slots.Floor (Addr);
               else
                  Allocation_Maps.Next (Iter);
               end if;
            end;
         end loop;
      end Remove_Free;

      --  ------------------------------
      --  Take into account a malloc probe.  The memory slot [Addr .. Slot.Size] is inserted
      --  in the used slots map.  The freed slots that intersect the malloc'ed region are
      --  removed from the freed map.
      --  ------------------------------
      procedure Probe_Malloc (Addr   : in MAT.Types.Target_Addr;
                              Slot   : in Allocation) is
      begin
         if Log.Get_Level = Util.Log.DEBUG_LEVEL then
            Log.Debug ("Malloc at {0} size {1}", MAT.Types.Hex_Image (Addr),
                       MAT.Types.Target_Size'Image (Slot.Size));
         end if;
         Remove_Free (Addr, Slot.Size);
         Used_Slots.Insert (Addr, Slot);
      end Probe_Malloc;

      --  ------------------------------
      --  Take into account a free probe.  Add the memory slot in the freed map and remove
      --  the slot from the used slots map.
      --  ------------------------------
      procedure Probe_Free (Addr   : in MAT.Types.Target_Addr;
                            Slot   : in Allocation) is
         Item : Allocation;
         Iter : Allocation_Cursor;
      begin
         if Log.Get_Level = Util.Log.DEBUG_LEVEL then
            Log.Debug ("Free {0}", MAT.Types.Hex_Image (Addr));
         end if;
         Iter := Used_Slots.Find (Addr);
         if Allocation_Maps.Has_Element (Iter) then
            Item := Allocation_Maps.Element (Iter);
            MAT.Frames.Release (Item.Frame);
            Used_Slots.Delete (Iter);
            Item.Frame := Slot.Frame;
            Freed_Slots.Insert (Addr, Item);
         end if;
      end Probe_Free;

      --  ------------------------------
      --  Take into account a realloc probe.  The old memory slot represented by Old_Addr is
      --  removed from the used slots maps and the new memory slot [Addr .. Slot.Size] is
      --  inserted in the used slots map.
      --  ------------------------------
      procedure Probe_Realloc (Addr     : in MAT.Types.Target_Addr;
                               Old_Addr : in MAT.Types.Target_Addr;
                               Slot     : in Allocation) is
         procedure Update_Size (Key     : in MAT.Types.Target_Addr;
                                Element : in out Allocation);

         procedure Update_Size (Key     : in MAT.Types.Target_Addr;
                                Element : in out Allocation) is
            pragma Unreferenced (Key);
         begin
            Element.Size := Slot.Size;
            MAT.Frames.Release (Element.Frame);
            Element.Frame := Slot.Frame;
         end Update_Size;

         Pos      : Allocation_Cursor;
      begin
         if Log.Get_Level = Util.Log.DEBUG_LEVEL then
            Log.Debug ("Realloc {0} to {1} size {2}", MAT.Types.Hex_Image (Old_Addr),
                       MAT.Types.Hex_Image (Addr), MAT.Types.Target_Size'Image (Slot.Size));
         end if;
         if Addr /= 0 then
            Pos := Used_Slots.Find (Old_Addr);
            if Allocation_Maps.Has_Element (Pos) then
               if Addr = Old_Addr then
                  Used_Slots.Update_Element (Pos, Update_Size'Access);
               else
                  Used_Slots.Delete (Pos);
                  Used_Slots.Insert (Addr, Slot);
               end if;
            else
               Used_Slots.Insert (Addr, Slot);
            end if;
            Remove_Free (Addr, Slot.Size);
         end if;
      end Probe_Realloc;

      --  ------------------------------
      --  Insert in the frame tree the new stack frame represented by <tt>Pc</tt>.
      --  If the frame is already known, the frame reference counter is incremented.
      --  The frame represented by <tt>Pc</tt> is returned in <tt>Result</tt>.
      --  ------------------------------
      procedure Create_Frame (Pc     : in MAT.Frames.Frame_Table;
                              Result : out MAT.Frames.Frame_Type) is
      begin
         MAT.Frames.Insert (Frames, Pc, Result);
      end Create_Frame;

      --  ------------------------------
      --  Collect the information about memory slot sizes allocated by the application.
      --  ------------------------------
      procedure Size_Information (Sizes  : in out MAT.Memory.Tools.Size_Info_Map) is
      begin
         MAT.Memory.Tools.Size_Information (Used_Slots, Sizes);
      end Size_Information;

      --  ------------------------------
      --  Collect the information about threads and the memory allocations they've made.
      --  ------------------------------
      procedure Thread_Information (Threads : in out Memory_Info_Map) is
      begin
         MAT.Memory.Tools.Thread_Information (Used_Slots, Threads);
      end Thread_Information;

      --  ------------------------------
      --  Find from the <tt>Memory</tt> map the memory slots whose address intersects
      --  the region [From .. To] and which is selected by the given filter expression.
      --  Add the memory slot in the <tt>Into</tt> list if it does not already contains
      --  the memory slot.
      --  ------------------------------
      procedure Find (From   : in MAT.Types.Target_Addr;
                      To     : in MAT.Types.Target_Addr;
                      Filter : in MAT.Expressions.Expression_Type;
                      Into   : in out MAT.Memory.Allocation_Map) is
      begin
         MAT.Memory.Tools.Find (Used_Slots, From, To, Filter, Into);
      end Find;

   end Memory_Allocator;

end MAT.Memory.Targets;

Add the Filter parameter to the Find operation


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

with AWS.Net.SSL;
with Servlet.Server.Web;

with AWA.Setup.Applications;
with AWA.Commands.Drivers;
with AWA.Commands.Start;
with AWA.Commands.Setup;
with AWA.Commands.Stop;
with AWA.Commands.List;
with AWA.Commands.Info;

with ADO.Drivers;
--  with ADO.Sqlite;
--  with ADO.Mysql;
--  with ADO.Postgresql;

with Atlas.Applications;
procedure Atlas.Server is

   package Server_Commands is
     new AWA.Commands.Drivers (Driver_Name => "atlas",
                               Container_Type => Servlet.Server.Web.AWS_Container);

   package List_Command is new AWA.Commands.List (Server_Commands);
   package Start_Command is new AWA.Commands.Start (Server_Commands);
   package Stop_Command is new AWA.Commands.Stop (Server_Commands);
   package Info_Command is new AWA.Commands.Info (Server_Commands);
   package Setup_Command is new AWA.Commands.Setup (Start_Command);

   Log       : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Atlas.Server");
   App       : constant Atlas.Applications.Application_Access := new Atlas.Applications.Application;
   WS        : Servlet.Server.Web.AWS_Container renames Server_Commands.WS;
   Context   : AWA.Commands.Context_Type;
   Arguments : Util.Commands.Dynamic_Argument_List;
begin
   --  Initialize the database drivers (all of them or specific ones).
   ADO.Drivers.Initialize;
   --  ADO.Sqlite.Initialize;
   --  ADO.Mysql.Initialize;
   --  ADO.Postgresql.Initialize;
   WS.Register_Application (Atlas.Applications.CONTEXT_PATH, App.all'Access);

   if not AWS.Net.SSL.Is_Supported then
      Log.Error ("SSL is not supported by AWS.");
      Log.Error ("SSL is required for the OAuth2/OpenID connector to "
                 & "connect to OAuth2/OpenID providers.");
      Log.Error ("Please, rebuild AWS with SSL support.");
   end if;

   Log.Info ("Connect you browser to: http://localhost:8080{0}/index.html",
             Atlas.Applications.CONTEXT_PATH);
   Server_Commands.Run (Context, Arguments);

exception
   when E : others =>
      Context.Print (E);
end Atlas.Server;

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

with AWS.Net.SSL;
with Servlet.Server.Web;

with AWA.Commands.Drivers;
with AWA.Commands.Start;
with AWA.Commands.Setup;
with AWA.Commands.Stop;
with AWA.Commands.List;
with AWA.Commands.Info;

with ADO.Drivers;
--  with ADO.Sqlite;
--  with ADO.Mysql;
--  with ADO.Postgresql;

with Atlas.Applications;
procedure Atlas.Server is

   package Server_Commands is
     new AWA.Commands.Drivers (Driver_Name => "atlas",
                               Container_Type => Servlet.Server.Web.AWS_Container);

   package List_Command is new AWA.Commands.List (Server_Commands);
   package Start_Command is new AWA.Commands.Start (Server_Commands);
   package Stop_Command is new AWA.Commands.Stop (Server_Commands);
   package Info_Command is new AWA.Commands.Info (Server_Commands);
   package Setup_Command is new AWA.Commands.Setup (Start_Command);

   Log       : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Atlas.Server");
   App       : constant Atlas.Applications.Application_Access
     := new Atlas.Applications.Application;
   WS        : Servlet.Server.Web.AWS_Container renames Server_Commands.WS;
   Context   : AWA.Commands.Context_Type;
   Arguments : Util.Commands.Dynamic_Argument_List;
begin
   --  Initialize the database drivers (all of them or specific ones).
   ADO.Drivers.Initialize;
   --  ADO.Sqlite.Initialize;
   --  ADO.Mysql.Initialize;
   --  ADO.Postgresql.Initialize;
   WS.Register_Application (Atlas.Applications.CONTEXT_PATH, App.all'Access);

   if not AWS.Net.SSL.Is_Supported then
      Log.Error ("SSL is not supported by AWS.");
      Log.Error ("SSL is required for the OAuth2/OpenID connector to "
                 & "connect to OAuth2/OpenID providers.");
      Log.Error ("Please, rebuild AWS with SSL support.");
   end if;

   Log.Info ("Connect you browser to: http://localhost:8080{0}/index.html",
             Atlas.Applications.CONTEXT_PATH);
   Server_Commands.Run (Context, Arguments);

exception
   when E : others =>
      Context.Print (E);
end Atlas.Server;

Fix compilation warnings

Fix compilation warnings


-----------------------------------------------------------------------
--  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
      procedure Update_Count (Size : in MAT.Types.Target_Size;
                              Info : in out Size_Info_Type);
      procedure Collect (Addr : in MAT.Types.Target_Addr;
                         Slot : in Allocation);

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

      procedure Collect (Addr : in MAT.Types.Target_Addr;
                         Slot : in Allocation) is
         pragma Unreferenced (Addr);

         Pos : constant 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;

      Iter : Allocation_Cursor := Memory.First;

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

   --  ------------------------------
   --  Collect the information about threads and the memory allocations they've made.
   --  ------------------------------
   procedure Thread_Information (Memory  : in MAT.Memory.Allocation_Map;
                                 Threads : in out Memory_Info_Map) is
      procedure Collect (Addr : in MAT.Types.Target_Addr;
                         Slot : in Allocation);

      procedure Collect (Addr : in MAT.Types.Target_Addr;
                         Slot : in Allocation) is

         procedure Update_Count (Thread : in MAT.Types.Target_Thread_Ref;
                                 Info   : in out Memory_Info);

         procedure Update_Count (Thread : in MAT.Types.Target_Thread_Ref;
                                 Info   : in out Memory_Info) is
            pragma Unreferenced (Thread);

            Size : constant MAT.Types.Target_Size := Slot.Size;
         begin
            Info.Alloc_Count := Info.Alloc_Count + 1;
            if Size < Info.Min_Slot_Size then
               Info.Min_Slot_Size := Size;
            end if;
            if Size > Info.Max_Slot_Size then
               Info.Max_Slot_Size := Size;
            end if;
            if Addr < Info.Min_Addr then
               Info.Min_Addr := Addr;
            end if;
            if Addr + Size > Info.Max_Addr then
               Info.Max_Addr := Addr + Size;
            end if;
            Info.Total_Size := Info.Total_Size + Size;
         end Update_Count;

         Pos : constant Memory_Info_Cursor := Threads.Find (Slot.Thread);
      begin
         if Memory_Info_Maps.Has_Element (Pos) then
            Threads.Update_Element (Pos, Update_Count'Access);
         else
            declare
               Info : Memory_Info;
            begin
               Info.Total_Size := Slot.Size;
               Info.Alloc_Count := 1;
               Info.Min_Slot_Size := Slot.Size;
               Info.Max_Slot_Size := Slot.Size;
               Info.Min_Addr      := Addr;
               Info.Max_Addr      := Addr + Slot.Size;
               Threads.Insert (Slot.Thread, Info);
            end;
         end if;
      end Collect;

      Iter : Allocation_Cursor := Memory.First;
   begin
      while Allocation_Maps.Has_Element (Iter) loop
         Allocation_Maps.Query_Element (Iter, Collect'Access);
         Allocation_Maps.Next (Iter);
      end loop;
   end Thread_Information;

   --  ------------------------------
   --  Find from the <tt>Memory</tt> map the memory slots whose address intersects
   --  the region [From .. To] and which is selected by the given filter expression.
   --  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;
                   Filter : in MAT.Expressions.Expression_Type;
                   Into   : in out MAT.Memory.Allocation_Map) is
      procedure Collect (Addr : in MAT.Types.Target_Addr;
                         Slot : in Allocation);

      procedure Collect (Addr : in MAT.Types.Target_Addr;
                         Slot : in Allocation) is
      begin
         if MAT.Expressions.Is_Selected (Filter, Addr, Slot) then
            Into.Insert (Addr, Slot);
         end if;
      end Collect;

      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
            Allocation_Maps.Query_Element (Iter, Collect'Access);
         end if;
         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
      procedure Update_Count (Size : in MAT.Types.Target_Size;
                              Info : in out Size_Info_Type);
      procedure Collect (Addr : in MAT.Types.Target_Addr;
                         Slot : in Allocation);

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

      procedure Collect (Addr : in MAT.Types.Target_Addr;
                         Slot : in Allocation) is
         pragma Unreferenced (Addr);

         Pos : constant 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;

      Iter : Allocation_Cursor := Memory.First;

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

   --  ------------------------------
   --  Collect the information about threads and the memory allocations they've made.
   --  ------------------------------
   procedure Thread_Information (Memory  : in MAT.Memory.Allocation_Map;
                                 Threads : in out Memory_Info_Map) is
      procedure Collect (Addr : in MAT.Types.Target_Addr;
                         Slot : in Allocation);

      procedure Collect (Addr : in MAT.Types.Target_Addr;
                         Slot : in Allocation) is

         procedure Update_Count (Thread : in MAT.Types.Target_Thread_Ref;
                                 Info   : in out Memory_Info);

         procedure Update_Count (Thread : in MAT.Types.Target_Thread_Ref;
                                 Info   : in out Memory_Info) is
            pragma Unreferenced (Thread);

            Size : constant MAT.Types.Target_Size := Slot.Size;
         begin
            Info.Alloc_Count := Info.Alloc_Count + 1;
            if Size < Info.Min_Slot_Size then
               Info.Min_Slot_Size := Size;
            end if;
            if Size > Info.Max_Slot_Size then
               Info.Max_Slot_Size := Size;
            end if;
            if Addr < Info.Min_Addr then
               Info.Min_Addr := Addr;
            end if;
            if Addr + Size > Info.Max_Addr then
               Info.Max_Addr := Addr + Size;
            end if;
            Info.Total_Size := Info.Total_Size + Size;
         end Update_Count;

         Pos : constant Memory_Info_Cursor := Threads.Find (Slot.Thread);
      begin
         if Memory_Info_Maps.Has_Element (Pos) then
            Threads.Update_Element (Pos, Update_Count'Access);
         else
            declare
               Info : Memory_Info;
            begin
               Info.Total_Size := Slot.Size;
               Info.Alloc_Count := 1;
               Info.Min_Slot_Size := Slot.Size;
               Info.Max_Slot_Size := Slot.Size;
               Info.Min_Addr      := Addr;
               Info.Max_Addr      := Addr + Slot.Size;
               Threads.Insert (Slot.Thread, Info);
            end;
         end if;
      end Collect;

      Iter : Allocation_Cursor := Memory.First;
   begin
      while Allocation_Maps.Has_Element (Iter) loop
         Allocation_Maps.Query_Element (Iter, Collect'Access);
         Allocation_Maps.Next (Iter);
      end loop;
   end Thread_Information;

   --  ------------------------------
   --  Collect the information about frames and the memory allocations they've made.
   --  ------------------------------
   procedure Frame_Information (Memory : in MAT.Memory.Allocation_Map;
                                Level  : in Natural;
                                Frames : in out Frame_Info_Map) is
      procedure Collect (Addr : in MAT.Types.Target_Addr;
                         Slot : in Allocation);

      procedure Collect (Addr : in MAT.Types.Target_Addr;
                         Slot : in Allocation) is

         procedure Update_Count (Frame_Addr : in MAT.Types.Target_Addr;
                                 Info       : in out Frame_Info);

         procedure Update_Count (Frame_Addr : in MAT.Types.Target_Addr;
                                 Info       : in out Frame_Info) is
            pragma Unreferenced (Frame_Addr);

            Size : constant MAT.Types.Target_Size := Slot.Size;
         begin
            Info.Memory.Alloc_Count := Info.Memory.Alloc_Count + 1;
            if Size < Info.Memory.Min_Slot_Size then
               Info.Memory.Min_Slot_Size := Size;
            end if;
            if Size > Info.Memory.Max_Slot_Size then
               Info.Memory.Max_Slot_Size := Size;
            end if;
            if Addr < Info.Memory.Min_Addr then
               Info.Memory.Min_Addr := Addr;
            end if;
            if Addr + Size > Info.Memory.Max_Addr then
               Info.Memory.Max_Addr := Addr + Size;
            end if;
            Info.Memory.Total_Size := Info.Memory.Total_Size + Size;
         end Update_Count;

         Frame : constant MAT.Frames.Frame_Table := MAT.Frames.Backtrace (Slot.Frame, Level);
         Pos   : Frame_Info_Cursor;
      begin
         for I in Frame'Range loop
            Pos := Frames.Find (Frame (I));
            if Frame_Info_Maps.Has_Element (Pos) then
               Frames.Update_Element (Pos, Update_Count'Access);
            else
               declare
                  Info : Frame_Info;
               begin
                  Info.Thread               := Slot.Thread;
                  Info.Memory.Total_Size    := Slot.Size;
                  Info.Memory.Alloc_Count   := 1;
                  Info.Memory.Min_Slot_Size := Slot.Size;
                  Info.Memory.Max_Slot_Size := Slot.Size;
                  Info.Memory.Min_Addr      := Addr;
                  Info.Memory.Max_Addr      := Addr + Slot.Size;
                  Frames.Insert (Frame (I), Info);
               end;
            end if;
         end loop;
      end Collect;

      Iter : Allocation_Cursor := Memory.First;
   begin
      while Allocation_Maps.Has_Element (Iter) loop
         Allocation_Maps.Query_Element (Iter, Collect'Access);
         Allocation_Maps.Next (Iter);
      end loop;
   end Frame_Information;

   --  ------------------------------
   --  Find from the <tt>Memory</tt> map the memory slots whose address intersects
   --  the region [From .. To] and which is selected by the given filter expression.
   --  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;
                   Filter : in MAT.Expressions.Expression_Type;
                   Into   : in out MAT.Memory.Allocation_Map) is
      procedure Collect (Addr : in MAT.Types.Target_Addr;
                         Slot : in Allocation);

      procedure Collect (Addr : in MAT.Types.Target_Addr;
                         Slot : in Allocation) is
      begin
         if MAT.Expressions.Is_Selected (Filter, Addr, Slot) then
            Into.Insert (Addr, Slot);
         end if;
      end Collect;

      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
            Allocation_Maps.Query_Element (Iter, Collect'Access);
         end if;
         Allocation_Maps.Next (Iter);
      end loop;
   end Find;

end MAT.Memory.Tools;

Implement the Frame_Information procedure


-----------------------------------------------------------------------
--  mat-targets-tests -- Unit tests for MAT targets
--  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 Util.Tests;

package MAT.Targets.Tests is

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite);

   type Test is new Util.Tests.Test with null record;

   procedure Test_Read_File (T : in out Test);

end MAT.Targets.Tests;

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

with Util.Tests;

package MAT.Targets.Tests is

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite);

   type Test is new Util.Tests.Test with null record;

   procedure Test_Read_File (T : in out Test);

   --  Test various type conversions.
   procedure Test_Conversions (T : in out Test);

end MAT.Targets.Tests;

Declare the Test_Conversions procedure

Declare the Test_Conversions procedure