with Ada.Command_Line;   use Ada.Command_Line;
with GNATCOLL.Strings_Impl;
with Ada.Calendar;       use Ada.Calendar;
with Ada.Characters.Handling;  use Ada.Characters.Handling;
with Ada.Strings.Unbounded;  use Ada.Strings.Unbounded;
with Ada.Text_IO;        use Ada.Text_IO;
with GNAT.Strings;       use GNAT.Strings;

procedure Test_Strings is
   Total  : constant := 2_000_000;

   Short : constant String := "small string";
   Long  : constant String :=
      "a much larger string that doesn't fit in small_string";

   type Test_Kind is
      (Small_Set_With_Reuse,
       Small_Set_No_Reuse,
       Large_Set_With_Reuse,
       Large_Set_No_Reuse,
       Small_Copy,
       Large_Copy,
       Small_Then_Append,
       Small_Then_Append_Char,
       Large_Then_Append,
       Trim);
   Test_Names : array (Test_Kind) of GNAT.Strings.String_Access :=
      (Small_Set_With_Reuse   => new String'("Small, set with reuse  "),
       Small_Set_No_Reuse     => new String'("Small, set no reuse    "),
       Large_Set_With_Reuse   => new String'("Large, set with reuse  "),
       Large_Set_No_Reuse     => new String'("Large, set no reuse    "),
       Small_Copy             => new String'("Small, copy            "),
       Large_Copy             => new String'("Large, copy            "),
       Small_Then_Append      => new String'("Small, then append     "),
       Small_Then_Append_Char => new String'("Small, then append char"),
       Large_Then_Append      => new String'("Large, then append     "),
       Trim                   => new String'("Trim                   "));
   Ref_Times : array (Test_Kind) of Duration := (others => 0.0);

   Do_Timings : Boolean := True;
   --  Measure timing if no argument is given on the command line

   To_Run : constant array (Test_Kind) of Boolean :=
      (Large_Copy           => True,
       others               => True);

   function Percent (Test : Test_Kind; D : Duration) return String
      is (if Ref_Times (Test) = 0.0 then ""
          else Natural'Image (Natural (D * 100 / Ref_Times (Test))) & '%');

   generic
      type SSize is mod <>;
      Copy_On_Write : Boolean;
   procedure Perf_Test;
   --  Performance tests for various instances of xstring

   procedure Unbounded_Test;
   --  Test for unbounded strings

   --------------------
   -- Unbounded_Test --
   --------------------

   procedure Unbounded_Test is
      Start  : Time;
      D      : Duration;
   begin
      Put_Line ("========== Unbounded strings =============");

      for Test in Test_Kind loop
         if To_Run (Test) then
            declare
               S, S2 : Unbounded_String;
            begin
               Put (Test_Names (Test).all & ":");
               Start := Clock;

               case Test is
               when Small_Set_With_Reuse =>
                  for J in 1 .. Total loop
                     Set_Unbounded_String (S, Short);
                  end loop;

               when Small_Set_No_Reuse =>
                  for J in 1 .. Total loop
                     S := To_Unbounded_String (Short);
                  end loop;

               when Large_Set_With_Reuse =>
                  for J in 1 .. Total loop
                     Set_Unbounded_String (S, Long);
                  end loop;

               when Large_Set_No_Reuse =>
                  for J in 1 .. Total loop
                     S := To_Unbounded_String (Long);
                  end loop;

               when Small_Copy =>
                  S2 := To_Unbounded_String (Short);
                  for J in 1 .. Total loop
                     S := S2;
                  end loop;

               when Large_Copy =>
                  S2 := To_Unbounded_String (Long);
                  for J in 1 .. Total loop
                     S := S2;
                  end loop;

               when Small_Then_Append =>
                  S := Null_Unbounded_String;
                  for J in 1 .. Total loop
                     Append (S, (1 => Character'Val (32 + J mod 100)));
                  end loop;

               when Small_Then_Append_Char =>
                  S := Null_Unbounded_String;
                  for J in 1 .. Total loop
                     Append (S, Character'Val (32 + J mod 100));
                  end loop;

               when Large_Then_Append =>
                  S := To_Unbounded_String (Long);
                  for J in 1 .. Total loop
                     Append (S, (1 => Character'Val (32 + J mod 100)));
                  end loop;

               when Trim =>
                  S := To_Unbounded_String ("   " & Long & "   ");
                  for J in 1 .. Total loop
                     S2 := Trim (S, Ada.Strings.Both);
                  end loop;
               end case;
            end;

            D := Clock - Start;

            if Do_Timings then
               Ref_Times (Test) := D;
               Put_Line (D'Img & "s 100%");
            else
               New_Line;
            end if;
         end if;
      end loop;
   end Unbounded_Test;

   ---------------
   -- Perf_Test --
   ---------------

   procedure Perf_Test is

      package Strings is new GNATCOLL.Strings_Impl.Strings
         (SSize            => SSize,
          Character_Type   => Character,
          Character_String => String,
          Copy_On_Write    => Copy_On_Write);
      use Strings;
      Start  : Time;
      D      : Duration;
   begin
      Put_Line
         ("======== ssize="
          & (if Do_Timings then SSize'Last'Img else "")
          & " COW=" & Copy_On_Write'Img
          & " ========");

      for Test in Test_Kind loop
         if To_Run (Test) then
            declare
               S, S2 : XString;
            begin
               Put (Test_Names (Test).all & ":");
               Start := Clock;

               case Test is
               when Small_Set_With_Reuse =>
                  for J in 1 .. Total loop
                     S.Set (Short);
                  end loop;

               when Small_Set_No_Reuse =>
                  for J in 1 .. Total loop
                     declare
                        S : XString;
                     begin
                        S.Set (Short);
                     end;
                  end loop;

               when Large_Set_With_Reuse =>
                  for J in 1 .. Total loop
                     S.Set (Long);
                  end loop;

               when Large_Set_No_Reuse =>
                  for J in 1 .. Total loop
                     declare
                        S : XString;
                     begin
                        S.Set (Long);
                     end;
                  end loop;

               when Small_Copy =>
                  S2.Set (Short);
                  for J in 1 .. Total loop
                     S := S2;
                  end loop;

               when Large_Copy =>
                  S2.Set (Long);
                  for J in 1 .. Total loop
                     S := S2;
                  end loop;

               when Small_Then_Append =>
                  S.Set ("");
                  for J in 1 .. Total loop
                     Append (S, (1 => Character'Val (32 + J mod 100)));
                  end loop;

               when Small_Then_Append_Char =>
                  S.Set ("");
                  for J in 1 .. Total loop
                     Append (S, Character'Val (32 + J mod 100));
                  end loop;

               when Large_Then_Append =>
                  S.Set (Long);
                  for J in 1 .. Total loop
                     Append (S, (1 => Character'Val (32 + J mod 100)));
                  end loop;

               when Trim =>
                  S.Set ("   " & Long & "   ");
                  for J in 1 .. Total loop
                     S2 := S;
                     S2.Trim (Ada.Strings.Both);
                  end loop;

               end case;
            end;

            D := Clock - Start;
            if Do_Timings then
               Put_Line (D'Img & "s " & Percent (Test, D));
            else
               New_Line;
            end if;
         end if;
      end loop;
   end Perf_Test;

   procedure Perf_Test_COW is
      new Perf_Test (GNATCOLL.Strings_Impl.Optimal_String_Size,
                     Copy_On_Write => True);
   procedure Perf_Test_No_COW is
      new Perf_Test (GNATCOLL.Strings_Impl.Optimal_String_Size,
                     Copy_On_Write => False);
   type SSize_3 is mod 128;
   procedure Perf_Test3 is new Perf_Test (SSize_3, Copy_On_Write => True);

   --  Invalid SSize: doesn't leave space for a flag bit
   --     type SSize_2 is mod 2 ** 8;
   --     for SSize_2'Size use 8;
   --     package Strings2 is new GNATCOLL.Strings_Impl (SSize_2);
   --     procedure Test2 is new Test (Strings2);

begin
   Do_Timings := Argument_Count = 0;

   Unbounded_Test;
   Perf_Test_No_COW;
   Perf_Test_COW;
   Perf_Test3;

   for T in Test_Names'Range loop
      Free (Test_Names (T));
   end loop;
end Test_Strings;
