-----------------------------------------------------------------------
--  measure -- Benchmark tools
--  Copyright (C) 2008, 2009, 2010, 2011, 2012, 2013, 2015, 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.Task_Attributes;
with Ada.Strings.Hash;
with Ada.Unchecked_Deallocation;
with GNAT.Calendar.Time_IO;

with Util.Streams.Buffered;
with Util.Streams.Texts.TR;
package body Util.Measures is

   ISO_DATE_TIME : constant GNAT.Calendar.Time_IO.Picture_String := "%Y-%m-%d %H:%M:%S";

   procedure Free is
     new Ada.Unchecked_Deallocation (Buckets_Type, Buckets_Access);

   procedure Free is
     new Ada.Unchecked_Deallocation (Measure, Measure_Access);

   procedure Free is
     new Ada.Unchecked_Deallocation (String, String_Access);

   package Task_Context is new Ada.Task_Attributes
     (Measure_Set_Access, null);

   function Format (D : in Duration) return String;

   --  Format the duration in a time in 'ns', 'us', 'ms' or seconds.
   function Format (D    : in Duration;
                    Unit : in Unit_Type) return String;

   --  ------------------------------
   --  Disable collecting measures on the measure set.
   --  ------------------------------
   procedure Disable (Measures : in out Measure_Set) is
   begin
      Measures.Enabled := False;
   end Disable;

   --  ------------------------------
   --  Enable collecting measures on the measure set.
   --  ------------------------------
   procedure Enable (Measures : in out Measure_Set) is
   begin
      Measures.Enabled := True;
   end Enable;

   --  ------------------------------
   --  Set the per-thread measure set.
   --  ------------------------------
   procedure Set_Current (Measures : in Measure_Set_Access) is
   begin
      Task_Context.Set_Value (Measures);
   end Set_Current;

   --  ------------------------------
   --  Get the per-thread measure set.
   --  ------------------------------
   function Get_Current return Measure_Set_Access is
   begin
      return Task_Context.Value;
   end Get_Current;

   --  ------------------------------
   --  Dump an XML result with the measures collected by the measure set.
   --  When writing the measures, the measure set is cleared.  It is safe
   --  to write measures while other measures are being collected.
   --  ------------------------------
   procedure Write (Measures : in out Measure_Set;
                    Title    : in String;
                    Stream   : in out Util.Streams.Texts.Print_Stream'Class) is

      use Util.Streams.Buffered;

      procedure Dump_XML (Item : in Measure_Access);

      procedure Dump_XML (Item : in Measure_Access) is
         Total : constant String := Format (Item.Time);
         Time  : constant String := Format (Item.Time / Item.Count);
      begin
         Stream.Write ("<time count=""");
         Stream.Write (Item.Count);
         Stream.Write (""" time=""");
         Stream.Write (Time (Time'First + 1 .. Time'Last));
         if Item.Count > 1 then
            Stream.Write (""" total=""");
            Stream.Write (Total (Total'First + 1 .. Total'Last));
         end if;
         Stream.Write (""" title=""");
         Util.Streams.Texts.TR.Escape_Java_Script (Into => Stream,
                                                   Content => Item.Name.all);
         Stream.Write ("""/>");
         Stream.Write (ASCII.LF);
      end Dump_XML;

      Buckets : Buckets_Access;
      TS, TE  : Ada.Calendar.Time;

   begin
      Measures.Data.Steal_Map (Buckets, TS, TE);
      Stream.Write ("<measures title=""");
      Util.Streams.Texts.TR.Escape_Java_Script (Into    => Stream,
                                                Content => Title);
      Stream.Write (""" start=""");
      Stream.Write (TS, ISO_DATE_TIME);
      Stream.Write (""" end=""");
      Stream.Write (TE, ISO_DATE_TIME);
      Stream.Write (""">");
      if Buckets /= null then
         begin
            for I in Buckets'Range loop
               declare
                  Next : Measure_Access;
                  Node : Measure_Access := Buckets (I);
               begin
                  while Node /= null loop
                     Dump_XML (Node);
                     Free (Node.Name);
                     Next := Node.Next;
                     Free (Node);
                     Node := Next;
                  end loop;
               end;
            end loop;

         exception
            when others =>
               Free (Buckets);
               raise;
         end;
         Free (Buckets);
      end if;
      Stream.Write ("</measures>");
   end Write;

   --  ------------------------------
   --  Dump an XML result with the measures collected by the measure set.
   --  ------------------------------
   procedure Write (Measures : in out Measure_Set;
                    Title    : in String;
                    Stream   : in Ada.Text_IO.File_Type) is

      Buffer : aliased Util.Streams.Buffered.Output_Buffer_Stream;
      Output : Util.Streams.Texts.Print_Stream;

   begin
      Buffer.Initialize (Size => 128 * 1024);
      Output.Initialize (To => Buffer'Unchecked_Access);
      Write (Measures, Title, Output);
      Output.Flush;
      Ada.Text_IO.Put_Line (Stream, Util.Streams.Texts.To_String (Buffer));
   end Write;

   --  ------------------------------
   --  Dump  an XML result with the measures in a file.
   --  ------------------------------
   procedure Write (Measures : in out Measure_Set;
                    Title    : in String;
                    Path     : in String) is
      File : Ada.Text_IO.File_Type;
   begin
      Ada.Text_IO.Create (File => File, Name => Path);
      Write (Measures, Title, File);
      Ada.Text_IO.Close (File);
   exception
      when others =>
         if Ada.Text_IO.Is_Open (File) then
            Ada.Text_IO.Close (File);
         end if;
         raise;
   end Write;

   --  ------------------------------
   --  Report the time spent between the stamp creation and this method call.
   --  Collect the result in the per-thread measure set under the given measure
   --  title.
   --  ------------------------------
   procedure Report (S     : in out Stamp;
                     Title : in String;
                     Count : in Positive := 1) is
      Measures : constant Measure_Set_Access := Task_Context.Value;
   begin
      if Measures /= null and then Measures.Enabled then
         Report (Measures.all, S, Title, Count);
      end if;
   end Report;

   --  ------------------------------
   --  Report the time spent between the stamp creation and this method call.
   --  Collect the result in the measure set under the given measure title.
   --  ------------------------------
   procedure Report (Measures : in out Measure_Set;
                     S        : in out Stamp;
                     Title    : in String;
                     Count    : in Positive := 1) is
      use Ada.Calendar;
   begin
      if Measures.Enabled then
         declare
            D : constant Duration := Ada.Calendar.Clock - S.Start;
         begin
            Measures.Data.Add (Title, D, Count);
         end;
         S.Start := Ada.Calendar.Clock;
      end if;
   end Report;

   --  ------------------------------
   --  Report the time spent between the stamp creation and this method call.
   --  The report is written in the file with the given title.  The duration is
   --  expressed in the unit defined in <tt>Unit</tt>.
   --  ------------------------------
   procedure Report (S     : in out Stamp;
                     File  : in out Ada.Text_IO.File_Type;
                     Title : in String;
                     Unit  : in Unit_Type := Microseconds) is
      use Ada.Calendar;

      D : constant Duration := Ada.Calendar.Clock - S.Start;
   begin
      Ada.Text_IO.Put (File, Title);
      Ada.Text_IO.Put (File, Format (D, Unit));
      S.Start := Ada.Calendar.Clock;
   end Report;

   protected body Measure_Data is

      --  ------------------------------
      --  Get the measures and clear to start a new set of measures.
      --  Return in Time_Start and Time_End the period of time.
      --  ------------------------------
      procedure Steal_Map (Result     : out Buckets_Access;
                           Time_Start : out Ada.Calendar.Time;
                           Time_End   : out Ada.Calendar.Time) is
      begin
         Result     := Buckets;
         Time_Start := Start;
         Start      := Ada.Calendar.Clock;
         Time_End   := Start;
         Buckets    := null;
      end Steal_Map;

      --  ------------------------------
      --  Add the measure
      --  ------------------------------
      procedure Add (Title : in String;
                     D     : in Duration;
                     Count : in Positive := 1) is

         use Ada.Containers;
         use Ada.Calendar;

         Pos  : Hash_Type;
         Node : Measure_Access;
      begin
         if Buckets = null then
            Buckets := new Buckets_Type (0 .. 256);
         end if;
         Pos := Ada.Strings.Hash (Title) mod Buckets'Length;
         Node := Buckets (Pos);
         while Node /= null loop
            if Node.Name'Length = Title'Length
              and then Node.Name.all = Title
            then
               Node.Count := Node.Count + Count;
               Node.Time := Node.Time + D;
               return;
            end if;
            Node := Node.Next;
         end loop;
         Buckets (Pos) := new Measure '(Name => new String '(Title),
                                        Time  => D,
                                        Count => Count,
                                        Next  => Buckets (Pos));
      end Add;

   end Measure_Data;

   --  ------------------------------
   --  Format the duration in a time in 'ns', 'us', 'ms' or seconds.
   --  ------------------------------
   function Format (D : in Duration) return String is
   begin
      if D < 0.000_001 then
         return Duration'Image (D * 1_000_000_000) (1 .. 6) & " ns";
      elsif D < 0.001 then
         return Duration'Image (D * 1_000_000) (1 .. 6) & " us";
      elsif D < 1.0 then
         return Duration'Image (D * 1_000) (1 .. 6) & " ms";
      else
         return Duration'Image (D) (1 .. 6) & " s";
      end if;
   end Format;

   --  ------------------------------
   --  Format the duration in a time in 'ns', 'us', 'ms' or seconds.
   --  ------------------------------
   function Format (D    : in Duration;
                    Unit : in Unit_Type) return String is
   begin
      case Unit is
         when Seconds =>
            return Duration'Image (D);

         when Milliseconds =>
            return Duration'Image (D * 1_000);

         when Microseconds =>
            return Duration'Image (D * 1_000_000);

         when Nanoseconds =>
            return Duration'Image (D * 1_000_000_000);

      end case;
   end Format;

   --  ------------------------------
   --  Finalize the measures and release the storage.
   --  ------------------------------
   overriding
   procedure Finalize (Measures : in out Measure_Set) is
      Buckets : Buckets_Access;
      TS, TE  : Ada.Calendar.Time;
   begin
      --  When deleting the measure set, we have to release the buckets and measures
      --  that were allocated.  We could call Write but we don't know where
      --  the measures have to be written.
      Measures.Data.Steal_Map (Buckets, TS, TE);
      if Buckets /= null then
         for I in Buckets'Range loop
            declare
               Next : Measure_Access;
               Node : Measure_Access := Buckets (I);
            begin
               while Node /= null loop
                  Free (Node.Name);
                  Next := Node.Next;
                  Free (Node);
                  Node := Next;
               end loop;
            end;
         end loop;
         Free (Buckets);
      end if;
   end Finalize;

end Util.Measures;

-----------------------------------------------------------------------
--  measure -- Benchmark tools
--  Copyright (C) 2008, 2009, 2010, 2011, 2012, 2013, 2015, 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.Task_Attributes;
with Ada.Strings.Hash;
with Ada.Unchecked_Deallocation;
with GNAT.Calendar.Time_IO;

with Util.Streams.Buffered;
with Util.Streams.Texts.TR;
package body Util.Measures is

   ISO_DATE_TIME : constant GNAT.Calendar.Time_IO.Picture_String := "%Y-%m-%d %H:%M:%S";

   procedure Free is
     new Ada.Unchecked_Deallocation (Buckets_Type, Buckets_Access);

   procedure Free is
     new Ada.Unchecked_Deallocation (Measure, Measure_Access);

   procedure Free is
     new Ada.Unchecked_Deallocation (String, String_Access);

   package Task_Context is new Ada.Task_Attributes
     (Measure_Set_Access, null);

   function Format (D : in Duration) return String;

   --  Format the duration in a time in 'ns', 'us', 'ms' or seconds.
   function Format (D    : in Duration;
                    Unit : in Unit_Type) return String;

   --  ------------------------------
   --  Disable collecting measures on the measure set.
   --  ------------------------------
   procedure Disable (Measures : in out Measure_Set) is
   begin
      Measures.Enabled := False;
   end Disable;

   --  ------------------------------
   --  Enable collecting measures on the measure set.
   --  ------------------------------
   procedure Enable (Measures : in out Measure_Set) is
   begin
      Measures.Enabled := True;
   end Enable;

   --  ------------------------------
   --  Set the per-thread measure set.
   --  ------------------------------
   procedure Set_Current (Measures : in Measure_Set_Access) is
   begin
      Task_Context.Set_Value (Measures);
   end Set_Current;

   --  ------------------------------
   --  Get the per-thread measure set.
   --  ------------------------------
   function Get_Current return Measure_Set_Access is
   begin
      return Task_Context.Value;
   end Get_Current;

   --  ------------------------------
   --  Dump an XML result with the measures collected by the measure set.
   --  When writing the measures, the measure set is cleared.  It is safe
   --  to write measures while other measures are being collected.
   --  ------------------------------
   procedure Write (Measures : in out Measure_Set;
                    Title    : in String;
                    Stream   : in out Util.Streams.Texts.Print_Stream'Class) is

      procedure Dump_XML (Item : in Measure_Access);

      procedure Dump_XML (Item : in Measure_Access) is
         Total : constant String := Format (Item.Time);
         Time  : constant String := Format (Item.Time / Item.Count);
      begin
         Stream.Write ("<time count=""");
         Stream.Write (Item.Count);
         Stream.Write (""" time=""");
         Stream.Write (Time (Time'First + 1 .. Time'Last));
         if Item.Count > 1 then
            Stream.Write (""" total=""");
            Stream.Write (Total (Total'First + 1 .. Total'Last));
         end if;
         Stream.Write (""" title=""");
         Util.Streams.Texts.TR.Escape_Java_Script (Into => Stream,
                                                   Content => Item.Name.all);
         Stream.Write ("""/>");
         Stream.Write (ASCII.LF);
      end Dump_XML;

      Buckets : Buckets_Access;
      TS, TE  : Ada.Calendar.Time;

   begin
      Measures.Data.Steal_Map (Buckets, TS, TE);
      Stream.Write ("<measures title=""");
      Util.Streams.Texts.TR.Escape_Java_Script (Into    => Stream,
                                                Content => Title);
      Stream.Write (""" start=""");
      Stream.Write (TS, ISO_DATE_TIME);
      Stream.Write (""" end=""");
      Stream.Write (TE, ISO_DATE_TIME);
      Stream.Write (""">");
      if Buckets /= null then
         begin
            for I in Buckets'Range loop
               declare
                  Next : Measure_Access;
                  Node : Measure_Access := Buckets (I);
               begin
                  while Node /= null loop
                     Dump_XML (Node);
                     Free (Node.Name);
                     Next := Node.Next;
                     Free (Node);
                     Node := Next;
                  end loop;
               end;
            end loop;

         exception
            when others =>
               Free (Buckets);
               raise;
         end;
         Free (Buckets);
      end if;
      Stream.Write ("</measures>");
   end Write;

   --  ------------------------------
   --  Dump an XML result with the measures collected by the measure set.
   --  ------------------------------
   procedure Write (Measures : in out Measure_Set;
                    Title    : in String;
                    Stream   : in Ada.Text_IO.File_Type) is

      Buffer : aliased Util.Streams.Buffered.Output_Buffer_Stream;
      Output : Util.Streams.Texts.Print_Stream;

   begin
      Buffer.Initialize (Size => 128 * 1024);
      Output.Initialize (To => Buffer'Unchecked_Access);
      Write (Measures, Title, Output);
      Output.Flush;
      Ada.Text_IO.Put_Line (Stream, Util.Streams.Texts.To_String (Buffer));
   end Write;

   --  ------------------------------
   --  Dump  an XML result with the measures in a file.
   --  ------------------------------
   procedure Write (Measures : in out Measure_Set;
                    Title    : in String;
                    Path     : in String) is
      File : Ada.Text_IO.File_Type;
   begin
      Ada.Text_IO.Create (File => File, Name => Path);
      Write (Measures, Title, File);
      Ada.Text_IO.Close (File);
   exception
      when others =>
         if Ada.Text_IO.Is_Open (File) then
            Ada.Text_IO.Close (File);
         end if;
         raise;
   end Write;

   --  ------------------------------
   --  Report the time spent between the stamp creation and this method call.
   --  Collect the result in the per-thread measure set under the given measure
   --  title.
   --  ------------------------------
   procedure Report (S     : in out Stamp;
                     Title : in String;
                     Count : in Positive := 1) is
      Measures : constant Measure_Set_Access := Task_Context.Value;
   begin
      if Measures /= null and then Measures.Enabled then
         Report (Measures.all, S, Title, Count);
      end if;
   end Report;

   --  ------------------------------
   --  Report the time spent between the stamp creation and this method call.
   --  Collect the result in the measure set under the given measure title.
   --  ------------------------------
   procedure Report (Measures : in out Measure_Set;
                     S        : in out Stamp;
                     Title    : in String;
                     Count    : in Positive := 1) is
      use Ada.Calendar;
   begin
      if Measures.Enabled then
         declare
            D : constant Duration := Ada.Calendar.Clock - S.Start;
         begin
            Measures.Data.Add (Title, D, Count);
         end;
         S.Start := Ada.Calendar.Clock;
      end if;
   end Report;

   --  ------------------------------
   --  Report the time spent between the stamp creation and this method call.
   --  The report is written in the file with the given title.  The duration is
   --  expressed in the unit defined in <tt>Unit</tt>.
   --  ------------------------------
   procedure Report (S     : in out Stamp;
                     File  : in out Ada.Text_IO.File_Type;
                     Title : in String;
                     Unit  : in Unit_Type := Microseconds) is
      use Ada.Calendar;

      D : constant Duration := Ada.Calendar.Clock - S.Start;
   begin
      Ada.Text_IO.Put (File, Title);
      Ada.Text_IO.Put (File, Format (D, Unit));
      S.Start := Ada.Calendar.Clock;
   end Report;

   protected body Measure_Data is

      --  ------------------------------
      --  Get the measures and clear to start a new set of measures.
      --  Return in Time_Start and Time_End the period of time.
      --  ------------------------------
      procedure Steal_Map (Result     : out Buckets_Access;
                           Time_Start : out Ada.Calendar.Time;
                           Time_End   : out Ada.Calendar.Time) is
      begin
         Result     := Buckets;
         Time_Start := Start;
         Start      := Ada.Calendar.Clock;
         Time_End   := Start;
         Buckets    := null;
      end Steal_Map;

      --  ------------------------------
      --  Add the measure
      --  ------------------------------
      procedure Add (Title : in String;
                     D     : in Duration;
                     Count : in Positive := 1) is

         use Ada.Containers;

         Pos  : Hash_Type;
         Node : Measure_Access;
      begin
         if Buckets = null then
            Buckets := new Buckets_Type (0 .. 256);
         end if;
         Pos := Ada.Strings.Hash (Title) mod Buckets'Length;
         Node := Buckets (Pos);
         while Node /= null loop
            if Node.Name'Length = Title'Length
              and then Node.Name.all = Title
            then
               Node.Count := Node.Count + Count;
               Node.Time := Node.Time + D;
               return;
            end if;
            Node := Node.Next;
         end loop;
         Buckets (Pos) := new Measure '(Name => new String '(Title),
                                        Time  => D,
                                        Count => Count,
                                        Next  => Buckets (Pos));
      end Add;

   end Measure_Data;

   --  ------------------------------
   --  Format the duration in a time in 'ns', 'us', 'ms' or seconds.
   --  ------------------------------
   function Format (D : in Duration) return String is
   begin
      if D < 0.000_001 then
         return Duration'Image (D * 1_000_000_000) (1 .. 6) & " ns";
      elsif D < 0.001 then
         return Duration'Image (D * 1_000_000) (1 .. 6) & " us";
      elsif D < 1.0 then
         return Duration'Image (D * 1_000) (1 .. 6) & " ms";
      else
         return Duration'Image (D) (1 .. 6) & " s";
      end if;
   end Format;

   --  ------------------------------
   --  Format the duration in a time in 'ns', 'us', 'ms' or seconds.
   --  ------------------------------
   function Format (D    : in Duration;
                    Unit : in Unit_Type) return String is
   begin
      case Unit is
         when Seconds =>
            return Duration'Image (D);

         when Milliseconds =>
            return Duration'Image (D * 1_000);

         when Microseconds =>
            return Duration'Image (D * 1_000_000);

         when Nanoseconds =>
            return Duration'Image (D * 1_000_000_000);

      end case;
   end Format;

   --  ------------------------------
   --  Finalize the measures and release the storage.
   --  ------------------------------
   overriding
   procedure Finalize (Measures : in out Measure_Set) is
      Buckets : Buckets_Access;
      TS, TE  : Ada.Calendar.Time;
   begin
      --  When deleting the measure set, we have to release the buckets and measures
      --  that were allocated.  We could call Write but we don't know where
      --  the measures have to be written.
      Measures.Data.Steal_Map (Buckets, TS, TE);
      if Buckets /= null then
         for I in Buckets'Range loop
            declare
               Next : Measure_Access;
               Node : Measure_Access := Buckets (I);
            begin
               while Node /= null loop
                  Free (Node.Name);
                  Next := Node.Next;
                  Free (Node);
                  Node := Next;
               end loop;
            end;
         end loop;
         Free (Buckets);
      end if;
   end Finalize;

end Util.Measures;

Fix compilation warning

Fix compilation warning


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

with Util.Test_Caller;
with Util.Texts.Builders;
with Util.Measures;

package body Util.Texts.Builders_Tests is

   package String_Builder is new Util.Texts.Builders (Element_Type => Character,
                                                      Input        => String,
                                                      Chunk_Size   => 100);

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Texts.Builders.Length",
                       Test_Length'Access);
      Caller.Add_Test (Suite, "Test Util.Texts.Builders.Append",
                       Test_Append'Access);
      Caller.Add_Test (Suite, "Test Util.Texts.Builders.Inline_Append",
                       Test_Inline_Append'Access);
      Caller.Add_Test (Suite, "Test Util.Texts.Builders.Clear",
                       Test_Clear'Access);
      Caller.Add_Test (Suite, "Test Util.Texts.Builders.Iterate",
                       Test_Iterate'Access);
      Caller.Add_Test (Suite, "Test Util.Texts.Builders.Inline_Iterate",
                       Test_Inline_Iterate'Access);
      Caller.Add_Test (Suite, "Test Util.Texts.Builders.Tail",
                       Test_Tail'Access);
      Caller.Add_Test (Suite, "Test Util.Texts.Builders.Perf",
                       Test_Perf'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test the length operation.
   --  ------------------------------
   procedure Test_Length (T : in out Test) is
      B : String_Builder.Builder (10);
   begin
      Util.Tests.Assert_Equals (T, 0, String_Builder.Length (B), "Invalid length");
      Util.Tests.Assert_Equals (T, 10, String_Builder.Capacity (B), "Invalid capacity");
   end Test_Length;

   --  ------------------------------
   --  Test the append operation.
   --  ------------------------------
   procedure Test_Append (T : in out Test) is
      S : constant String := "0123456789";
      B : String_Builder.Builder (3);
   begin
      String_Builder.Append (B, "a string");
      Util.Tests.Assert_Equals (T, 8, String_Builder.Length (B), "Invalid length");
      Util.Tests.Assert_Equals (T, "a string", String_Builder.To_Array (B), "Invalid content");
      Util.Tests.Assert_Equals (T, 100 + 3, String_Builder.Capacity (B), "Invalid capacity");

      --  Append new string and check content.
      String_Builder.Append (B, " b string");
      Util.Tests.Assert_Equals (T, 17, String_Builder.Length (B), "Invalid length");
      Util.Tests.Assert_Equals (T, "a string b string", String_Builder.To_Array (B),
                                "Invalid content");
      Util.Tests.Assert_Equals (T, 100 + 3, String_Builder.Capacity (B), "Invalid capacity");

      String_Builder.Clear (B);
      for I in S'Range loop
         String_Builder.Append (B, S (I));
      end loop;
      Util.Tests.Assert_Equals (T, 10, String_Builder.Length (B), "Invalid length");
      Util.Tests.Assert_Equals (T, S, String_Builder.To_Array (B), "Invalid append");
   end Test_Append;

   --  ------------------------------
   --  Test the append operation.
   --  ------------------------------
   procedure Test_Inline_Append (T : in out Test) is
      procedure Append (Into : in out String;
                        Last : out Natural);

      S : constant String := "0123456789";
      I : Positive := S'First;
      B : String_Builder.Builder (3);

      procedure Append (Into : in out String;
                        Last : out Natural) is
         Pos : Natural := Into'First;
      begin
         while Pos <= Into'Last and I <= S'Last loop
            Into (Pos) := S (I);
            Pos := Pos + 1;
            I := I + 1;
         end loop;
         Last := Pos - 1;
      end Append;

      procedure Fill is new String_Builder.Inline_Append (Append);

   begin
      Fill (B);
      Util.Tests.Assert_Equals (T, S'Length, String_Builder.Length (B), "Invalid length");
      Util.Tests.Assert_Equals (T, "0123456789", String_Builder.To_Array (B), "Invalid content");

      I := S'First;
      Fill (B);
      Util.Tests.Assert_Equals (T, "01234567890123456789",
                                String_Builder.To_Array (B), "Invalid content");

      String_Builder.Clear (B);
      I := S'Last;
      Fill (B);
      Util.Tests.Assert_Equals (T, "9", String_Builder.To_Array (B), "Invalid content");

      String_Builder.Clear (B);
      I := S'Last + 1;
      Fill (B);
      Util.Tests.Assert_Equals (T, "", String_Builder.To_Array (B), "Invalid content");
   end Test_Inline_Append;

   --  ------------------------------
   --  Test the clear operation.
   --  ------------------------------
   procedure Test_Clear (T : in out Test) is
      B : String_Builder.Builder (7);
   begin
      for I in 1 .. 10 loop
         String_Builder.Append (B, "a string");
      end loop;
      Util.Tests.Assert_Equals (T, 8 * 10, String_Builder.Length (B), "Invalid length");
      Util.Tests.Assert_Equals (T, 100 + 7, String_Builder.Capacity (B), "Invalid capacity");

      String_Builder.Clear (B);
      Util.Tests.Assert_Equals (T, 0, String_Builder.Length (B), "Invalid length after clear");
      Util.Tests.Assert_Equals (T, 7, String_Builder.Capacity (B), "Invalid capacity after clear");
   end Test_Clear;

   --  ------------------------------
   --  Test the tail operation.
   --  ------------------------------
   procedure Test_Tail (T : in out Test) is

      procedure Check_Tail (Min : in Positive;
                            Max : in Positive;
                            L   : in Natural);

      procedure Check_Tail (Min : in Positive;
                            Max : in Positive;
                            L   : in Natural) is
         P : constant String := "0123456789";
         B : String_Builder.Builder (Min);
      begin
         for I in 1 .. Max loop
            String_Builder.Append (B, P (1 + (I mod 10)));
         end loop;
         declare
            S  : constant String := String_Builder.Tail (B, L);
            S2 : constant String := String_Builder.To_Array (B);
         begin
            Util.Tests.Assert_Equals (T, Max, S2'Length, "Invalid length");
            if L >= Max then
               Util.Tests.Assert_Equals (T, S2, S, "Invalid Tail result");
            else
               Util.Tests.Assert_Equals (T, S2 (S2'Last - L + 1 .. S2'Last), S,
                                         "Invalid Tail result {"
                                         & Positive'Image (Min) & ","
                                         & Positive'Image (Max) & ","
                                         & Positive'Image (L) & "]");
            end if;
         end;
      end Check_Tail;

   begin
      for I in 1 .. 100 loop
         for J in 1 .. 8 loop
            for K in 1 .. I + 3 loop
               Check_Tail (J, I, K);
            end loop;
         end loop;
      end loop;
   end Test_Tail;

   --  ------------------------------
   --  Test the iterate operation.
   --  ------------------------------
   procedure Test_Iterate (T : in out Test) is
      procedure Process (S : in String);

      B  : String_Builder.Builder (13);
      R  : Ada.Strings.Unbounded.Unbounded_String;

      procedure Process (S : in String) is
      begin
         Ada.Strings.Unbounded.Append (R, S);
      end Process;
   begin
      for I in 1 .. 100 loop
         String_Builder.Append (B, "The Iterate procedure avoids the string copy "
                                & "on the secondary stack");
      end loop;
      String_Builder.Iterate (B, Process'Access);
      Util.Tests.Assert_Equals (T, String_Builder.Length (B), Ada.Strings.Unbounded.Length (R),
                                "Invalid length in iterate string");
      Util.Tests.Assert_Equals (T, String_Builder.To_Array (B),
                                Ada.Strings.Unbounded.To_String (R), "Invalid Iterate");
   end Test_Iterate;

   --  ------------------------------
   --  Test the iterate operation.
   --  ------------------------------
   procedure Test_Inline_Iterate (T : in out Test) is
      procedure Process (S : in String);

      B  : String_Builder.Builder (13);
      R  : Ada.Strings.Unbounded.Unbounded_String;

      procedure Process (S : in String) is
      begin
         Ada.Strings.Unbounded.Append (R, S);
      end Process;

      procedure Get is new String_Builder.Inline_Iterate (Process);
   begin
      for I in 1 .. 100 loop
         String_Builder.Append (B, "The Iterate procedure avoids the string copy "
                                & "on the secondary stack");
      end loop;
      Get (B);
      Util.Tests.Assert_Equals (T, String_Builder.Length (B), Ada.Strings.Unbounded.Length (R),
                                "Invalid length in iterate string");
      Util.Tests.Assert_Equals (T, String_Builder.To_Array (B),
                                Ada.Strings.Unbounded.To_String (R), "Invalid Iterate");
   end Test_Inline_Iterate;

   --  ------------------------------
   --  Test the append and iterate performance.
   --  ------------------------------
   procedure Test_Perf (T : in out Test) is
      Perf : Ada.Text_IO.File_Type;
   begin
      Ada.Text_IO.Create (File => Perf,
                          Name => Util.Tests.Get_Test_Path ("string-append.csv"));
      Ada.Text_IO.Put_Line (Perf, "Block_Size,Append Time,To_Array Time,Iterate Time");
      for Block_Size in 1 .. 300 loop
         declare
            B : String_Builder.Builder (10);
            N : constant String := Natural'Image (Block_Size * 10) & ",";
         begin
            String_Builder.Set_Block_Size (B, Block_Size * 10);
            declare
               S : Util.Measures.Stamp;
            begin
               for I in 1 .. 1000 loop
                  String_Builder.Append (B, "some item");
               end loop;
               Util.Measures.Report (S, Perf, N, Util.Measures.Microseconds);
            end;
            declare
               S : Util.Measures.Stamp;
               R : constant String := String_Builder.To_Array (B);
            begin
               Util.Measures.Report (S, Perf, ",", Util.Measures.Microseconds);
               T.Assert (R'Length > 0, "Invalid string length");
            end;

            declare
               Count : Natural := 0;

               procedure Process (Item : in String);

               procedure Process (Item : in String) is
                  pragma Unreferenced (Item);
               begin
                  Count := Count + 1;
               end Process;

               S : Util.Measures.Stamp;
            begin
               String_Builder.Iterate (B, Process'Access);
               Util.Measures.Report (S, Perf, ",", Util.Measures.Microseconds);
               T.Assert (Count > 0, "The string builder was empty");
            end;
         end;
         Ada.Text_IO.New_Line (Perf);
      end loop;
      Ada.Text_IO.Close (Perf);

      Ada.Text_IO.Create (File => Perf,
                          Name => Util.Tests.Get_Test_Path ("string.csv"));
      Ada.Text_IO.Put_Line (Perf, "Size,Append (100),Append (512),"
                            & "Append (1024),Unbounded,Iterate Time");
      for I in 1 .. 4000 loop
         declare
            N  : constant String := Natural'Image (I) & ",";
            B  : String_Builder.Builder (10);
            B2 : String_Builder.Builder (10);
            B3 : String_Builder.Builder (10);
            U  : Ada.Strings.Unbounded.Unbounded_String;
            S  : Util.Measures.Stamp;
         begin
            for J in 1 .. I loop
               String_Builder.Append (B, "some item");
            end loop;
            Util.Measures.Report (S, Perf, N, Util.Measures.Microseconds);

            String_Builder.Set_Block_Size (B2, 512);
            for J in 1 .. I loop
               String_Builder.Append (B2, "some item");
            end loop;
            Util.Measures.Report (S, Perf, ",", Util.Measures.Microseconds);

            String_Builder.Set_Block_Size (B3, 1024);
            for J in 1 .. I loop
               String_Builder.Append (B3, "some item");
            end loop;
            Util.Measures.Report (S, Perf, ",", Util.Measures.Microseconds);

            for J in 1 .. I loop
               Ada.Strings.Unbounded.Append (U, "some item");
            end loop;
            Util.Measures.Report (S, Perf, ",", Util.Measures.Microseconds);

            declare
               R : constant String := String_Builder.To_Array (B);
               pragma Unreferenced (R);
            begin
               Util.Measures.Report (S, Perf, ",", Util.Measures.Microseconds);
            end;

            declare
               R : constant String := Ada.Strings.Unbounded.To_String (U);
               pragma Unreferenced (R);
            begin
               Util.Measures.Report (S, Perf, ",", Util.Measures.Microseconds);
            end;
         end;
         Ada.Text_IO.New_Line (Perf);
      end loop;
   end Test_Perf;

end Util.Texts.Builders_Tests;

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

with Util.Test_Caller;
with Util.Texts.Builders;
with Util.Measures;

package body Util.Texts.Builders_Tests is

   package String_Builder is new Util.Texts.Builders (Element_Type => Character,
                                                      Input        => String,
                                                      Chunk_Size   => 100);

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Texts.Builders.Length",
                       Test_Length'Access);
      Caller.Add_Test (Suite, "Test Util.Texts.Builders.Append",
                       Test_Append'Access);
      Caller.Add_Test (Suite, "Test Util.Texts.Builders.Inline_Append",
                       Test_Inline_Append'Access);
      Caller.Add_Test (Suite, "Test Util.Texts.Builders.Clear",
                       Test_Clear'Access);
      Caller.Add_Test (Suite, "Test Util.Texts.Builders.Iterate",
                       Test_Iterate'Access);
      Caller.Add_Test (Suite, "Test Util.Texts.Builders.Inline_Iterate",
                       Test_Inline_Iterate'Access);
      Caller.Add_Test (Suite, "Test Util.Texts.Builders.Tail",
                       Test_Tail'Access);
      Caller.Add_Test (Suite, "Test Util.Texts.Builders.Find",
                       Test_Find'Access);
      Caller.Add_Test (Suite, "Test Util.Texts.Builders.Perf",
                       Test_Perf'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test the length operation.
   --  ------------------------------
   procedure Test_Length (T : in out Test) is
      B : String_Builder.Builder (10);
   begin
      Util.Tests.Assert_Equals (T, 0, String_Builder.Length (B), "Invalid length");
      Util.Tests.Assert_Equals (T, 10, String_Builder.Capacity (B), "Invalid capacity");
   end Test_Length;

   --  ------------------------------
   --  Test the append operation.
   --  ------------------------------
   procedure Test_Append (T : in out Test) is
      S : constant String := "0123456789";
      B : String_Builder.Builder (3);
   begin
      String_Builder.Append (B, "a string");
      Util.Tests.Assert_Equals (T, 8, String_Builder.Length (B), "Invalid length");
      Util.Tests.Assert_Equals (T, "a string", String_Builder.To_Array (B), "Invalid content");
      Util.Tests.Assert_Equals (T, 100 + 3, String_Builder.Capacity (B), "Invalid capacity");

      --  Append new string and check content.
      String_Builder.Append (B, " b string");
      Util.Tests.Assert_Equals (T, 17, String_Builder.Length (B), "Invalid length");
      Util.Tests.Assert_Equals (T, "a string b string", String_Builder.To_Array (B),
                                "Invalid content");
      Util.Tests.Assert_Equals (T, 100 + 3, String_Builder.Capacity (B), "Invalid capacity");

      String_Builder.Clear (B);
      for I in S'Range loop
         String_Builder.Append (B, S (I));
      end loop;
      Util.Tests.Assert_Equals (T, 10, String_Builder.Length (B), "Invalid length");
      Util.Tests.Assert_Equals (T, S, String_Builder.To_Array (B), "Invalid append");
   end Test_Append;

   --  ------------------------------
   --  Test the append operation.
   --  ------------------------------
   procedure Test_Inline_Append (T : in out Test) is
      procedure Append (Into : in out String;
                        Last : out Natural);

      S : constant String := "0123456789";
      I : Positive := S'First;
      B : String_Builder.Builder (3);

      procedure Append (Into : in out String;
                        Last : out Natural) is
         Pos : Natural := Into'First;
      begin
         while Pos <= Into'Last and I <= S'Last loop
            Into (Pos) := S (I);
            Pos := Pos + 1;
            I := I + 1;
         end loop;
         Last := Pos - 1;
      end Append;

      procedure Fill is new String_Builder.Inline_Append (Append);

   begin
      Fill (B);
      Util.Tests.Assert_Equals (T, S'Length, String_Builder.Length (B), "Invalid length");
      Util.Tests.Assert_Equals (T, "0123456789", String_Builder.To_Array (B), "Invalid content");

      I := S'First;
      Fill (B);
      Util.Tests.Assert_Equals (T, "01234567890123456789",
                                String_Builder.To_Array (B), "Invalid content");

      String_Builder.Clear (B);
      I := S'Last;
      Fill (B);
      Util.Tests.Assert_Equals (T, "9", String_Builder.To_Array (B), "Invalid content");

      String_Builder.Clear (B);
      I := S'Last + 1;
      Fill (B);
      Util.Tests.Assert_Equals (T, "", String_Builder.To_Array (B), "Invalid content");
   end Test_Inline_Append;

   --  ------------------------------
   --  Test the Find generic operation.
   --  ------------------------------
   procedure Test_Find (T : in out Test) is

      B : String_Builder.Builder (3);

      function Index (Content : in String) return Natural is
      begin
         for I in Content'Range loop
            if Content (I) = 'b' then
               return I;
            end if;
         end loop;
         return 0;
      end Index;

      function Find is new String_Builder.Find (Index);

      Pos : Natural;
   begin
      String_Builder.Append (B, "ab");
      Pos := Find (B, 1);
      Util.Tests.Assert_Equals (T, 2, Pos, "Invalid find");

      String_Builder.Append (B, "deab");
      Pos := Find (B, Pos + 1);
      Util.Tests.Assert_Equals (T, 6, Pos, "Invalid find");

      Pos := Find (B, Pos + 1);
      Util.Tests.Assert_Equals (T, 0, Pos, "Invalid find");
   end Test_Find;

   --  ------------------------------
   --  Test the clear operation.
   --  ------------------------------
   procedure Test_Clear (T : in out Test) is
      B : String_Builder.Builder (7);
   begin
      for I in 1 .. 10 loop
         String_Builder.Append (B, "a string");
      end loop;
      Util.Tests.Assert_Equals (T, 8 * 10, String_Builder.Length (B), "Invalid length");
      Util.Tests.Assert_Equals (T, 100 + 7, String_Builder.Capacity (B), "Invalid capacity");

      String_Builder.Clear (B);
      Util.Tests.Assert_Equals (T, 0, String_Builder.Length (B), "Invalid length after clear");
      Util.Tests.Assert_Equals (T, 7, String_Builder.Capacity (B), "Invalid capacity after clear");
   end Test_Clear;

   --  ------------------------------
   --  Test the tail operation.
   --  ------------------------------
   procedure Test_Tail (T : in out Test) is

      procedure Check_Tail (Min : in Positive;
                            Max : in Positive;
                            L   : in Natural);

      procedure Check_Tail (Min : in Positive;
                            Max : in Positive;
                            L   : in Natural) is
         P : constant String := "0123456789";
         B : String_Builder.Builder (Min);
      begin
         for I in 1 .. Max loop
            String_Builder.Append (B, P (1 + (I mod 10)));
         end loop;
         declare
            S  : constant String := String_Builder.Tail (B, L);
            S2 : constant String := String_Builder.To_Array (B);
         begin
            Util.Tests.Assert_Equals (T, Max, S2'Length, "Invalid length");
            if L >= Max then
               Util.Tests.Assert_Equals (T, S2, S, "Invalid Tail result");
            else
               Util.Tests.Assert_Equals (T, S2 (S2'Last - L + 1 .. S2'Last), S,
                                         "Invalid Tail result {"
                                         & Positive'Image (Min) & ","
                                         & Positive'Image (Max) & ","
                                         & Positive'Image (L) & "]");
            end if;
         end;
      end Check_Tail;

   begin
      for I in 1 .. 100 loop
         for J in 1 .. 8 loop
            for K in 1 .. I + 3 loop
               Check_Tail (J, I, K);
            end loop;
         end loop;
      end loop;
   end Test_Tail;

   --  ------------------------------
   --  Test the iterate operation.
   --  ------------------------------
   procedure Test_Iterate (T : in out Test) is
      procedure Process (S : in String);

      B  : String_Builder.Builder (13);
      R  : Ada.Strings.Unbounded.Unbounded_String;

      procedure Process (S : in String) is
      begin
         Ada.Strings.Unbounded.Append (R, S);
      end Process;
   begin
      for I in 1 .. 100 loop
         String_Builder.Append (B, "The Iterate procedure avoids the string copy "
                                & "on the secondary stack");
      end loop;
      String_Builder.Iterate (B, Process'Access);
      Util.Tests.Assert_Equals (T, String_Builder.Length (B), Ada.Strings.Unbounded.Length (R),
                                "Invalid length in iterate string");
      Util.Tests.Assert_Equals (T, String_Builder.To_Array (B),
                                Ada.Strings.Unbounded.To_String (R), "Invalid Iterate");
   end Test_Iterate;

   --  ------------------------------
   --  Test the iterate operation.
   --  ------------------------------
   procedure Test_Inline_Iterate (T : in out Test) is
      procedure Process (S : in String);

      B  : String_Builder.Builder (13);
      R  : Ada.Strings.Unbounded.Unbounded_String;

      procedure Process (S : in String) is
      begin
         Ada.Strings.Unbounded.Append (R, S);
      end Process;

      procedure Get is new String_Builder.Inline_Iterate (Process);
   begin
      for I in 1 .. 100 loop
         String_Builder.Append (B, "The Iterate procedure avoids the string copy "
                                & "on the secondary stack");
      end loop;
      Get (B);
      Util.Tests.Assert_Equals (T, String_Builder.Length (B), Ada.Strings.Unbounded.Length (R),
                                "Invalid length in iterate string");
      Util.Tests.Assert_Equals (T, String_Builder.To_Array (B),
                                Ada.Strings.Unbounded.To_String (R), "Invalid Iterate");
   end Test_Inline_Iterate;

   --  ------------------------------
   --  Test the append and iterate performance.
   --  ------------------------------
   procedure Test_Perf (T : in out Test) is
      Perf : Ada.Text_IO.File_Type;
   begin
      Ada.Text_IO.Create (File => Perf,
                          Name => Util.Tests.Get_Test_Path ("string-append.csv"));
      Ada.Text_IO.Put_Line (Perf, "Block_Size,Append Time,To_Array Time,Iterate Time");
      for Block_Size in 1 .. 300 loop
         declare
            B : String_Builder.Builder (10);
            N : constant String := Natural'Image (Block_Size * 10) & ",";
         begin
            String_Builder.Set_Block_Size (B, Block_Size * 10);
            declare
               S : Util.Measures.Stamp;
            begin
               for I in 1 .. 1000 loop
                  String_Builder.Append (B, "some item");
               end loop;
               Util.Measures.Report (S, Perf, N, Util.Measures.Microseconds);
            end;
            declare
               S : Util.Measures.Stamp;
               R : constant String := String_Builder.To_Array (B);
            begin
               Util.Measures.Report (S, Perf, ",", Util.Measures.Microseconds);
               T.Assert (R'Length > 0, "Invalid string length");
            end;

            declare
               Count : Natural := 0;

               procedure Process (Item : in String);

               procedure Process (Item : in String) is
                  pragma Unreferenced (Item);
               begin
                  Count := Count + 1;
               end Process;

               S : Util.Measures.Stamp;
            begin
               String_Builder.Iterate (B, Process'Access);
               Util.Measures.Report (S, Perf, ",", Util.Measures.Microseconds);
               T.Assert (Count > 0, "The string builder was empty");
            end;
         end;
         Ada.Text_IO.New_Line (Perf);
      end loop;
      Ada.Text_IO.Close (Perf);

      Ada.Text_IO.Create (File => Perf,
                          Name => Util.Tests.Get_Test_Path ("string.csv"));
      Ada.Text_IO.Put_Line (Perf, "Size,Append (100),Append (512),"
                            & "Append (1024),Unbounded,Iterate Time");
      for I in 1 .. 4000 loop
         declare
            N  : constant String := Natural'Image (I) & ",";
            B  : String_Builder.Builder (10);
            B2 : String_Builder.Builder (10);
            B3 : String_Builder.Builder (10);
            U  : Ada.Strings.Unbounded.Unbounded_String;
            S  : Util.Measures.Stamp;
         begin
            for J in 1 .. I loop
               String_Builder.Append (B, "some item");
            end loop;
            Util.Measures.Report (S, Perf, N, Util.Measures.Microseconds);

            String_Builder.Set_Block_Size (B2, 512);
            for J in 1 .. I loop
               String_Builder.Append (B2, "some item");
            end loop;
            Util.Measures.Report (S, Perf, ",", Util.Measures.Microseconds);

            String_Builder.Set_Block_Size (B3, 1024);
            for J in 1 .. I loop
               String_Builder.Append (B3, "some item");
            end loop;
            Util.Measures.Report (S, Perf, ",", Util.Measures.Microseconds);

            for J in 1 .. I loop
               Ada.Strings.Unbounded.Append (U, "some item");
            end loop;
            Util.Measures.Report (S, Perf, ",", Util.Measures.Microseconds);

            declare
               R : constant String := String_Builder.To_Array (B);
               pragma Unreferenced (R);
            begin
               Util.Measures.Report (S, Perf, ",", Util.Measures.Microseconds);
            end;

            declare
               R : constant String := Ada.Strings.Unbounded.To_String (U);
               pragma Unreferenced (R);
            begin
               Util.Measures.Report (S, Perf, ",", Util.Measures.Microseconds);
            end;
         end;
         Ada.Text_IO.New_Line (Perf);
      end loop;
   end Test_Perf;

end Util.Texts.Builders_Tests;

Add the Test_Find procedure and register the new test for execution


-----------------------------------------------------------------------
--  ado.schemas -- Database Schemas
--  Copyright (C) 2009, 2010, 2011, 2015, 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 ADO.Statements;
with ADO.Statements.Create;
with ADO.SQL;
with Ada.Strings.Fixed;
package body ADO.Schemas.Mysql is

   use ADO.Statements;

   procedure Load_Table_Schema (C : in ADO.Connections.Database_Connection'Class;
                                Table : in Table_Definition);

   function String_To_Type (Value : in String) return Column_Type;
   function String_To_Length (Value : in String) return Natural;

   function String_To_Type (Value : in String) return Column_Type is
      Pos : Natural;
   begin
      if Value = "date" then
         return T_DATE;
      elsif Value = "datetime" then
         return T_DATE_TIME;
      elsif Value = "int(11)" then
         return T_INTEGER;
      elsif Value = "bigint(20)" then
         return T_LONG_INTEGER;
      elsif Value = "tinyint(4)" then
         return T_TINYINT;
      elsif Value = "smallint(6)" then
         return T_SMALLINT;
      elsif Value = "longblob" then
         return T_BLOB;
      end if;
      Pos := Ada.Strings.Fixed.Index (Value, "(");
      if Pos > 0 then
         declare
            Name : constant String := Value (Value'First .. Pos - 1);
         begin
            if Name = "varchar" then
               return T_VARCHAR;
            elsif Name = "decimal" then
               return T_FLOAT;
            elsif Name = "int" then
               return T_INTEGER;
            elsif Name = "bigint" then
               return T_LONG_INTEGER;
            else
               return T_UNKNOWN;
            end if;
         end;
      end if;
      return T_UNKNOWN;
   end String_To_Type;

   function String_To_Length (Value : in String) return Natural is
      First : Natural;
      Last  : Natural;
   begin
      First := Ada.Strings.Fixed.Index (Value, "(");
      if First = 0 then
         return 0;
      end if;
      Last := Ada.Strings.Fixed.Index (Value, ")");
      if Last < First then
         return 0;
      end if;
      return Natural'Value (Value (First + 1 .. Last - 1));

   exception
      when Constraint_Error =>
         return 0;
   end String_To_Length;

   --  ------------------------------
   --  Load the table definition
   --  ------------------------------
   procedure Load_Table_Schema (C : in ADO.Connections.Database_Connection'Class;
                                Table : in Table_Definition) is
      Name : constant String := Get_Name (Table);
      Stmt : Query_Statement
        := Create.Create_Statement (C.Create_Statement ("show full columns from "));
      Last : Column_Definition := null;
      Col  : Column_Definition;
      Value : Unbounded_String;
      Query : constant ADO.SQL.Query_Access := Stmt.Get_Query;
   begin
      ADO.SQL.Append_Name (Target => Query.SQL, Name => Name);
      Stmt.Execute;
      while Stmt.Has_Elements loop
         Col           := new Column;
         Col.Name      := Stmt.Get_Unbounded_String (0);
         if not Stmt.Is_Null (2) then
            Col.Collation := Stmt.Get_Unbounded_String (2);
         end if;
         if not Stmt.Is_Null (5) then
            Col.Default   := Stmt.Get_Unbounded_String (5);
         end if;
         if Last /= null then
            Last.Next_Column := Col;
         else
            Table.First_Column := Col;
         end if;

         Value := Stmt.Get_Unbounded_String (1);
         Col.Col_Type := String_To_Type (To_String (Value));
         Col.Size := String_To_Length (To_String (Value));

         Value := Stmt.Get_Unbounded_String (3);
         Col.Is_Null := Value = "YES";

         Value := Stmt.Get_Unbounded_String (4);
         Col.Is_Primary := Value = "PRI";

         Last := Col;
         Stmt.Next;
      end loop;
   end Load_Table_Schema;

   --  ------------------------------
   --  Load the database schema
   --  ------------------------------
   procedure Load_Schema (C      : in ADO.Connections.Database_Connection'Class;
                          Schema : out Schema_Definition) is
      Stmt  : Query_Statement
        := Create.Create_Statement (C.Create_Statement ("show tables"));
      Table : Table_Definition;
      Last  : Table_Definition := null;
   begin
      Schema.Schema := new ADO.Schemas.Schema;
      Stmt.Execute;

      while Stmt.Has_Elements loop
         Table      := new ADO.Schemas.Table;
         Table.Name := Stmt.Get_Unbounded_String (0);
         if Last /= null then
            Last.Next_Table := Table;
         else
            Schema.Schema.First_Table := Table;
         end if;
         Load_Table_Schema (C, Table);
         Last := Table;
         Stmt.Next;
      end loop;
   end Load_Schema;

end ADO.Schemas.Mysql;

-----------------------------------------------------------------------
--  ado.schemas -- Database Schemas
--  Copyright (C) 2009, 2010, 2011, 2015, 2018, 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 ADO.Statements;
with ADO.Statements.Create;
with ADO.SQL;
with Ada.Strings.Fixed;
package body ADO.Schemas.Mysql is

   use ADO.Statements;

   procedure Load_Table_Schema (C : in ADO.Connections.Database_Connection'Class;
                                Table : in Table_Definition);

   function String_To_Type (Value : in String) return Column_Type;
   function String_To_Length (Value : in String) return Natural;

   function String_To_Type (Value : in String) return Column_Type is
      Pos : Natural;
   begin
      if Value = "date" then
         return T_DATE;
      elsif Value = "datetime" then
         return T_DATE_TIME;
      elsif Value = "int(11)" then
         return T_INTEGER;
      elsif Value = "bigint(20)" then
         return T_LONG_INTEGER;
      elsif Value = "tinyint(4)" then
         return T_TINYINT;
      elsif Value = "smallint(6)" then
         return T_SMALLINT;
      elsif Value = "longblob" then
         return T_BLOB;
      elsif Value = "float" then
         return T_FLOAT;
      elsif Value = "double" then
         return T_DOUBLE;
      end if;
      Pos := Ada.Strings.Fixed.Index (Value, "(");
      if Pos > 0 then
         declare
            Name : constant String := Value (Value'First .. Pos - 1);
         begin
            if Name = "varchar" then
               return T_VARCHAR;
            elsif Name = "decimal" then
               return T_FLOAT;
            elsif Name = "int" then
               return T_INTEGER;
            elsif Name = "bigint" then
               return T_LONG_INTEGER;
            else
               return T_UNKNOWN;
            end if;
         end;
      end if;
      return T_UNKNOWN;
   end String_To_Type;

   function String_To_Length (Value : in String) return Natural is
      First : Natural;
      Last  : Natural;
   begin
      First := Ada.Strings.Fixed.Index (Value, "(");
      if First = 0 then
         return 0;
      end if;
      Last := Ada.Strings.Fixed.Index (Value, ")");
      if Last < First then
         return 0;
      end if;
      return Natural'Value (Value (First + 1 .. Last - 1));

   exception
      when Constraint_Error =>
         return 0;
   end String_To_Length;

   --  ------------------------------
   --  Load the table definition
   --  ------------------------------
   procedure Load_Table_Schema (C : in ADO.Connections.Database_Connection'Class;
                                Table : in Table_Definition) is
      Name : constant String := Get_Name (Table);
      Stmt : Query_Statement
        := Create.Create_Statement (C.Create_Statement ("show full columns from "));
      Last : Column_Definition := null;
      Col  : Column_Definition;
      Value : Unbounded_String;
      Query : constant ADO.SQL.Query_Access := Stmt.Get_Query;
   begin
      ADO.SQL.Append_Name (Target => Query.SQL, Name => Name);
      Stmt.Execute;
      while Stmt.Has_Elements loop
         Col           := new Column;
         Col.Name      := Stmt.Get_Unbounded_String (0);
         if not Stmt.Is_Null (2) then
            Col.Collation := Stmt.Get_Unbounded_String (2);
         end if;
         if not Stmt.Is_Null (5) then
            Col.Default   := Stmt.Get_Unbounded_String (5);
         end if;
         if Last /= null then
            Last.Next_Column := Col;
         else
            Table.First_Column := Col;
         end if;

         Value := Stmt.Get_Unbounded_String (1);
         Col.Col_Type := String_To_Type (To_String (Value));
         Col.Size := String_To_Length (To_String (Value));

         Value := Stmt.Get_Unbounded_String (3);
         Col.Is_Null := Value = "YES";

         Value := Stmt.Get_Unbounded_String (4);
         Col.Is_Primary := Value = "PRI";

         Last := Col;
         Stmt.Next;
      end loop;
   end Load_Table_Schema;

   --  ------------------------------
   --  Load the database schema
   --  ------------------------------
   procedure Load_Schema (C      : in ADO.Connections.Database_Connection'Class;
                          Schema : out Schema_Definition) is
      Stmt  : Query_Statement
        := Create.Create_Statement (C.Create_Statement ("show tables"));
      Table : Table_Definition;
      Last  : Table_Definition := null;
   begin
      Schema.Schema := new ADO.Schemas.Schema;
      Stmt.Execute;

      while Stmt.Has_Elements loop
         Table      := new ADO.Schemas.Table;
         Table.Name := Stmt.Get_Unbounded_String (0);
         if Last /= null then
            Last.Next_Table := Table;
         else
            Schema.Schema.First_Table := Table;
         end if;
         Load_Table_Schema (C, Table);
         Last := Table;
         Stmt.Next;
      end loop;
   end Load_Schema;

end ADO.Schemas.Mysql;

Fix support for float and double when loading Mysql schema


-----------------------------------------------------------------------
--  util-log-appenders -- Log appenders
--  Copyright (C) 2001, 2002, 2003, 2006, 2008, 2009, 2010, 2011, 2015, 2018 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Calendar.Formatting;
with Ada.Strings;
with Ada.Strings.Fixed;

with Util.Strings.Transforms;
with Util.Log.Loggers;
with Util.Properties.Basic;
package body Util.Log.Appenders is

   use Ada;

   --  ------------------------------
   --  Get the log level that triggers display of the log events
   --  ------------------------------
   function Get_Level (Self : in Appender) return Level_Type is
   begin
      return Self.Level;
   end Get_Level;

   --  ------------------------------
   --  Set the log level.
   --  ------------------------------
   procedure Set_Level (Self       : in out Appender;
                        Name       : in String;
                        Properties : in Util.Properties.Manager;
                        Level      : in Level_Type) is
      Prop_Name : constant String := Name & ".level";
   begin
      if Properties.Exists (Prop_Name) then
         Self.Level := Get_Level (Properties.Get (Prop_Name), Level);
      else
         Self.Level := Level;
      end if;
   end Set_Level;

   --  ------------------------------
   --  Set the log layout format.
   --  ------------------------------
   procedure Set_Layout (Self       : in out Appender;
                         Name       : in String;
                         Properties : in Util.Properties.Manager;
                         Layout     : in Layout_Type) is
      use Ada.Strings;
      use Util.Strings.Transforms;
      Prop_Name : constant String := Name & ".layout";
   begin
      if Properties.Exists (Prop_Name) then
         declare
            Value : constant String
              := To_Lower_Case (Fixed.Trim (Properties.Get (Prop_Name), Both));
         begin
            if Value = "message" then
               Self.Layout := MESSAGE;
            elsif Value = "level-message" then
               Self.Layout := LEVEL_MESSAGE;
            elsif Value = "date-level-message" or Value = "level-date-message" then
               Self.Layout := DATE_LEVEL_MESSAGE;
            else
               Self.Layout := FULL;
            end if;
         end;
      else
         Self.Layout := Layout;
      end if;
   end Set_Layout;

   --  ------------------------------
   --  Format the event into a string
   --  ------------------------------
   function Format (Self  : in Appender;
                    Event : in Log_Event) return String is
   begin
      case Self.Layout is
         when MESSAGE =>
            return To_String (Event.Message);

         when LEVEL_MESSAGE =>
            return Get_Level_Name (Event.Level) & ": " & To_String (Event.Message);

         when DATE_LEVEL_MESSAGE =>
            return "[" & Calendar.Formatting.Image (Event.Time) & "] "
              & Get_Level_Name (Event.Level) & ": "
              & To_String (Event.Message);

         when FULL =>
            return "[" & Calendar.Formatting.Image (Event.Time) & "] "
              & Get_Level_Name (Event.Level) & " - "
              & Loggers.Get_Logger_Name (Event.Logger.all) & " - "
              & To_String (Event.Message);

      end case;
   end Format;

   procedure Append (Self  : in out File_Appender;
                     Event : in Log_Event) is
   begin
      if Self.Level >= Event.Level then
         Text_IO.Put_Line (Self.Output, Format (Self, Event));
         if Self.Immediate_Flush then
            Self.Flush;
         end if;
      end if;
   end Append;

   --  ------------------------------
   --  Flush the log events.
   --  ------------------------------
   overriding
   procedure Flush (Self   : in out File_Appender) is
   begin
      Text_IO.Flush (Self.Output);
   end Flush;

   --  ------------------------------
   --  Flush and close the file.
   --  ------------------------------
   overriding
   procedure Finalize (Self : in out File_Appender) is
   begin
      Self.Flush;
      Text_IO.Close (File => Self.Output);
   end Finalize;

   --  ------------------------------
   --  Create a file appender and configure it according to the properties
   --  ------------------------------
   function Create_File_Appender (Name       : in String;
                                  Properties : in Util.Properties.Manager;
                                  Default    : in Level_Type)
                                  return Appender_Access is
      use Util.Properties.Basic;

      Path   : constant String := Properties.Get (Name & ".File");
      Append : constant Boolean := Boolean_Property.Get (Properties, Name & ".append", True);
      Result : constant File_Appender_Access := new File_Appender;
   begin
      Result.Set_Level (Name, Properties, Default);
      Result.Set_Layout (Name, Properties, FULL);
      Result.Set_File (Path, Append);
      Result.Immediate_Flush := Boolean_Property.Get (Properties, Name & ".immediateFlush", True);
      return Result.all'Access;
   end Create_File_Appender;

   --  ------------------------------
   --  Set the file where the appender will write the logs.
   --  When <tt>Append</tt> is true, the log message are appended to the existing file.
   --  When set to false, the file is cleared before writing new messages.
   --  ------------------------------
   procedure Set_File (Self : in out File_Appender;
                       Path : in String;
                       Append : in Boolean := True) is
      Mode   : Text_IO.File_Mode;
   begin
      if Append then
         Mode := Text_IO.Append_File;
      else
         Mode := Text_IO.Out_File;
      end if;
      Text_IO.Open (File => Self.Output,
                    Name => Path,
                    Mode => Mode);
   exception
      when Text_IO.Name_Error =>
         Text_IO.Create (File => Self.Output, Name => Path);
   end Set_File;

   procedure Append (Self  : in out Console_Appender;
                     Event : in Log_Event) is
   begin
      if Self.Level >= Event.Level then
         Text_IO.Put_Line (Format (Self, Event));
      end if;
   end Append;

   --  ------------------------------
   --  Flush the log events.
   --  ------------------------------
   overriding
   procedure Flush (Self : in out Console_Appender) is
      pragma Unreferenced (Self);
   begin
      Text_IO.Flush;
   end Flush;

   overriding
   procedure Append (Self  : in out List_Appender;
                     Event : in Log_Event) is
   begin
      for I in 1 .. Self.Count loop
         Self.Appenders (I).Append (Event);
      end loop;
   end Append;

   --  ------------------------------
   --  Create a console appender and configure it according to the properties
   --  ------------------------------
   function Create_Console_Appender (Name       : in String;
                                     Properties : in Util.Properties.Manager;
                                     Default    : in Level_Type)
                                     return Appender_Access is
      Result : constant Console_Appender_Access := new Console_Appender;
   begin
      Result.Set_Level (Name, Properties, Default);
      Result.Set_Layout (Name, Properties, FULL);
      return Result.all'Access;
   end Create_Console_Appender;

   --  ------------------------------
   --  Flush the log events.
   --  ------------------------------
   overriding
   procedure Flush (Self   : in out List_Appender) is
   begin
      for I in 1 .. Self.Count loop
         Self.Appenders (I).Flush;
      end loop;
   end Flush;

   --  ------------------------------
   --  Add the appender to the list.
   --  ------------------------------
   procedure Add_Appender (Self   : in out List_Appender;
                           Object : in Appender_Access) is
   begin
      if Self.Count < Self.Appenders'Last then
         Self.Count := Self.Count + 1;
         Self.Appenders (Self.Count) := Object;
      end if;
   end Add_Appender;

   --  ------------------------------
   --  Create a list appender and configure it according to the properties
   --  ------------------------------
   function Create_List_Appender return List_Appender_Access is
      Result : constant List_Appender_Access := new List_Appender;
   begin
      return Result;
   end Create_List_Appender;

end Util.Log.Appenders;

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

with Util.Strings.Transforms;
with Util.Log.Loggers;
with Util.Properties.Basic;
package body Util.Log.Appenders is

   use Ada;

   --  ------------------------------
   --  Get the log level that triggers display of the log events
   --  ------------------------------
   function Get_Level (Self : in Appender) return Level_Type is
   begin
      return Self.Level;
   end Get_Level;

   --  ------------------------------
   --  Set the log level.
   --  ------------------------------
   procedure Set_Level (Self       : in out Appender;
                        Name       : in String;
                        Properties : in Util.Properties.Manager;
                        Level      : in Level_Type) is
      Prop_Name : constant String := Name & ".level";
   begin
      if Properties.Exists (Prop_Name) then
         Self.Level := Get_Level (Properties.Get (Prop_Name), Level);
      else
         Self.Level := Level;
      end if;
   end Set_Level;

   --  ------------------------------
   --  Set the log layout format.
   --  ------------------------------
   procedure Set_Layout (Self       : in out Appender;
                         Name       : in String;
                         Properties : in Util.Properties.Manager;
                         Layout     : in Layout_Type) is
      use Ada.Strings;
      use Util.Strings.Transforms;
      Prop_Name : constant String := Name & ".layout";
   begin
      if Properties.Exists (Prop_Name) then
         declare
            Value : constant String
              := To_Lower_Case (Fixed.Trim (Properties.Get (Prop_Name), Both));
         begin
            if Value = "message" then
               Self.Layout := MESSAGE;
            elsif Value = "level-message" then
               Self.Layout := LEVEL_MESSAGE;
            elsif Value = "date-level-message" or Value = "level-date-message" then
               Self.Layout := DATE_LEVEL_MESSAGE;
            else
               Self.Layout := FULL;
            end if;
         end;
      else
         Self.Layout := Layout;
      end if;
   end Set_Layout;

   --  ------------------------------
   --  Format the event into a string
   --  ------------------------------
   function Format (Self  : in Appender;
                    Event : in Log_Event) return String is
   begin
      case Self.Layout is
         when MESSAGE =>
            return To_String (Event.Message);

         when LEVEL_MESSAGE =>
            return Get_Level_Name (Event.Level) & ": " & To_String (Event.Message);

         when DATE_LEVEL_MESSAGE =>
            return "[" & Calendar.Formatting.Image (Event.Time) & "] "
              & Get_Level_Name (Event.Level) & ": "
              & To_String (Event.Message);

         when FULL =>
            return "[" & Calendar.Formatting.Image (Event.Time) & "] "
              & Get_Level_Name (Event.Level) & " - "
              & Loggers.Get_Logger_Name (Event.Logger.all) & " - "
              & To_String (Event.Message);

      end case;
   end Format;

   procedure Append (Self  : in out File_Appender;
                     Event : in Log_Event) is
   begin
      if Self.Level >= Event.Level then
         Text_IO.Put_Line (Self.Output, Format (Self, Event));
         if Self.Immediate_Flush then
            Self.Flush;
         end if;
      end if;
   end Append;

   --  ------------------------------
   --  Flush the log events.
   --  ------------------------------
   overriding
   procedure Flush (Self   : in out File_Appender) is
   begin
      Text_IO.Flush (Self.Output);
   end Flush;

   --  ------------------------------
   --  Flush and close the file.
   --  ------------------------------
   overriding
   procedure Finalize (Self : in out File_Appender) is
   begin
      Self.Flush;
      Text_IO.Close (File => Self.Output);
   end Finalize;

   --  ------------------------------
   --  Create a file appender and configure it according to the properties
   --  ------------------------------
   function Create_File_Appender (Name       : in String;
                                  Properties : in Util.Properties.Manager;
                                  Default    : in Level_Type)
                                  return Appender_Access is
      use Util.Properties.Basic;

      Path   : constant String := Properties.Get (Name & ".File");
      Append : constant Boolean := Boolean_Property.Get (Properties, Name & ".append", True);
      Result : constant File_Appender_Access := new File_Appender;
   begin
      Result.Set_Level (Name, Properties, Default);
      Result.Set_Layout (Name, Properties, FULL);
      Result.Set_File (Path, Append);
      Result.Immediate_Flush := Boolean_Property.Get (Properties, Name & ".immediateFlush", True);
      return Result.all'Access;
   end Create_File_Appender;

   --  ------------------------------
   --  Set the file where the appender will write the logs.
   --  When <tt>Append</tt> is true, the log message are appended to the existing file.
   --  When set to false, the file is cleared before writing new messages.
   --  ------------------------------
   procedure Set_File (Self : in out File_Appender;
                       Path : in String;
                       Append : in Boolean := True) is
      Mode   : Text_IO.File_Mode;
   begin
      if Append then
         Mode := Text_IO.Append_File;
      else
         Mode := Text_IO.Out_File;
      end if;
      Text_IO.Open (File => Self.Output,
                    Name => Path,
                    Mode => Mode);
   exception
      when Text_IO.Name_Error =>
         Text_IO.Create (File => Self.Output, Name => Path);
   end Set_File;

   procedure Append (Self  : in out Console_Appender;
                     Event : in Log_Event) is
   begin
      if Self.Level >= Event.Level then
         Text_IO.Put_Line (Self.Output.all, Format (Self, Event));
      end if;
   end Append;

   --  ------------------------------
   --  Flush the log events.
   --  ------------------------------
   overriding
   procedure Flush (Self : in out Console_Appender) is
   begin
      Text_IO.Flush (Self.Output.all);
   end Flush;

   overriding
   procedure Append (Self  : in out List_Appender;
                     Event : in Log_Event) is
   begin
      for I in 1 .. Self.Count loop
         Self.Appenders (I).Append (Event);
      end loop;
   end Append;

   --  ------------------------------
   --  Create a console appender and configure it according to the properties
   --  ------------------------------
   function Create_Console_Appender (Name       : in String;
                                     Properties : in Util.Properties.Manager;
                                     Default    : in Level_Type)
                                     return Appender_Access is
      use Util.Properties.Basic;

      Result : constant Console_Appender_Access := new Console_Appender;
      Stderr : constant Boolean := Boolean_Property.Get (Properties, Name & ".stderr", False);
   begin
      Result.Set_Level (Name, Properties, Default);
      Result.Set_Layout (Name, Properties, FULL);
      Result.Output := (if Stderr then Text_IO.Standard_Error else Text_IO.Standard_Output);
      return Result.all'Access;
   end Create_Console_Appender;

   --  ------------------------------
   --  Flush the log events.
   --  ------------------------------
   overriding
   procedure Flush (Self   : in out List_Appender) is
   begin
      for I in 1 .. Self.Count loop
         Self.Appenders (I).Flush;
      end loop;
   end Flush;

   --  ------------------------------
   --  Add the appender to the list.
   --  ------------------------------
   procedure Add_Appender (Self   : in out List_Appender;
                           Object : in Appender_Access) is
   begin
      if Self.Count < Self.Appenders'Last then
         Self.Count := Self.Count + 1;
         Self.Appenders (Self.Count) := Object;
      end if;
   end Add_Appender;

   --  ------------------------------
   --  Create a list appender and configure it according to the properties
   --  ------------------------------
   function Create_List_Appender return List_Appender_Access is
      Result : constant List_Appender_Access := new List_Appender;
   begin
      return Result;
   end Create_List_Appender;

end Util.Log.Appenders;

Update the console appender to write the message on standard output or standard error