with Ada.Calendar;         use Ada.Calendar;
with Ada.Text_IO;          use Ada.Text_IO;
with GNATCOLL.Traces;      use GNATCOLL.Traces;
with GNATCOLL.Traces_Old;  use GNATCOLL.Traces_Old;
with GNATCOLL.Utils;       use GNATCOLL.Utils;
with Support;              use Support;

procedure Main is
   Me     : GNATCOLL.Traces.Trace_Handle;
   Me_Old : GNATCOLL.Traces_Old.Trace_Handle;
   Total  : constant := 200_000;

   Ref : Float := 0.0;
   --  Reference timing.
   --  This is the time it took to display Total messages, via a single
   --  thread, using GNAT.Task_Locks, before any of the changes for P623-028

   procedure Internal_Check_Active (Threads : Natural);
   procedure Internal (Threads : Natural);

   task type Emit (Max : Natural);
   task body Emit is
   begin
      for J in 1 .. Max loop
         Trace (Me, "some trace");
      end loop;
   end Emit;

   task type Check_And_Emit (Max : Natural);
   task body Check_And_Emit is
   begin
      for J in 1 .. Max loop
         if Active (Me) then
            Trace (Me, "some trace");
         end if;
      end loop;
   end Check_And_Emit;

   procedure Internal (Threads : Natural) is
      T1 : array (1 .. Threads) of Emit (Total / Threads);
   begin
      null;
   end Internal;

   procedure Internal_Check_Active (Threads : Natural) is
      T1 : array (1 .. Threads) of Check_And_Emit (Total / Threads);
   begin
      null;
   end Internal_Check_Active;

   task type Old_Emit (Max : Natural);
   task body Old_Emit is
   begin
      for J in 1 .. Max loop
         Trace (Me_Old, "some trace");
      end loop;
   end Old_Emit;

   task type Old_Check_And_Emit (Max : Natural);
   task body Old_Check_And_Emit is
   begin
      for J in 1 .. Max loop
         if Active (Me_Old) then
            Trace (Me_Old, "some trace");
         end if;
      end loop;
   end Old_Check_And_Emit;

   procedure Old_Internal (Threads : Natural) is
      T1 : array (1 .. Threads) of Old_Emit (Total / Threads);
   begin
      null;
   end Old_Internal;

   procedure Old_Internal_Check_Active (Threads : Natural) is
      T1 : array (1 .. Threads) of Old_Check_And_Emit (Total / Threads);
   begin
      null;
   end Old_Internal_Check_Active;

   generic
      Prefix : String;
      with procedure Internal (Threads : Natural);
      with procedure Internal_Check (Threads : Natural);
   procedure Run_Tests
      (Handle_Name    : String;
       Threads        : Natural;
       Run_No_Flush   : Boolean := True;
       Run_Auto_Flush : Boolean := True;
       Run_Inactive   : Boolean := True);

   procedure Run_Tests
      (Handle_Name    : String;
       Threads        : Natural;
       Run_No_Flush   : Boolean := True;
       Run_Auto_Flush : Boolean := True;
       Run_Inactive   : Boolean := True)
   is
      Start  : Time;

      procedure Show_Result (Msg : String);
      procedure Show_Result (Msg : String) is
         D       : constant Duration := Clock - Start;
         Percent : Natural;
         Ops     : Natural;
      begin
         if Ref = 0.0 then
            Ref := Float (D);
         end if;

         Percent := Natural (Float (D) / Ref * 100.0);
         Ops := Natural (Float (Total) / Float (D));
         Put_Line (Msg & D'Img
            & Image (Percent, Min_Width => 5, Padding => ' ')
            & '%'
            & Image (Ops, Min_Width => 10, Padding => ' ')
            & " ops/s ("
            & (if Prefix = "Old" then Unit_Name (Me_Old) else Unit_Name (Me))
            & ")");
      end Show_Result;

   begin
      Me     := Create (Handle_Name);
      Me_Old := Create (Handle_Name);

      Put_Line
         ("=======" & Prefix & ' ' & Threads'Img & " threads ==========");

      Set_Active (Me, True);
      Set_Active (Me_Old, True);

      if Run_No_Flush then
         Start := Clock;
         Internal (Threads);
         Show_Result ("Total time                    ");
      end if;

      if Run_Auto_Flush then
         Me := Create ("AUTOFLUSH");

         Start := Clock;
         Internal (Threads);
         Show_Result ("Total time (auto flush)       ");

         Me := Create (Handle_Name);
      end if;

      if Run_Inactive then
         Set_Active (Me, False);
         Set_Active (Me_Old, False);

         Start := Clock;
         Internal (Threads);
         Show_Result ("Total time (when inactive)    ");

         Start := Clock;
         Internal_Check (Threads);
         Show_Result ("Total time (check active)     ");
      end if;

      Flush (Standard_Output);
      Flush (Standard_Error);
   end Run_Tests;

   procedure New_R is new Run_Tests
      ("New" ,Internal, Internal_Check_Active);
   procedure Old_R is new Run_Tests
      ("Old", Old_Internal, Old_Internal_Check_Active);

begin
   if True then
      GNATCOLL.Traces_Old.Register_Stream_Factory
         ("null", new Old_Null_Stream_Factory);
      GNATCOLL.Traces_Old.Parse_Config_File;
      Old_R ("MAIN", Threads => 1,   Run_No_Flush => False);
      Old_R ("MAIN", Threads => 8,   Run_No_Flush => False);
      Old_R ("MAIN", Threads => 10, Run_No_Flush => False);
   end if;

   GNATCOLL.Traces.Register_Stream_Factory ("null", new Null_Stream_Factory);
   GNATCOLL.Traces.Parse_Config_File;
   New_R ("MAIN", Threads => 1);
   New_R ("MAIN", Threads => 8);
   New_R ("MAIN", Threads => 10);

   Old_R ("NULL", Threads => 1,  Run_Inactive => False, Run_No_Flush => False);
   New_R ("NULL", Threads => 1,  Run_Inactive => False, Run_No_Flush => True,
          Run_Auto_Flush => False);
   New_R ("NULL", Threads => 64, Run_Inactive => False, Run_No_Flush => True,
          Run_Auto_Flush => False);

   --  Check buffering: we expect to see all stderr output at once, since it
   --  is unbuffered, then all the stdout outputs.

   for J in 1 .. 3 loop
      Trace (GNATCOLL.Traces.Create ("STDOUT"), "message" & J'Img);
      Trace (GNATCOLL.Traces.Create ("STDOUT_NO_BUFFER"), "message" & J'Img);
      delay 1.0;
   end loop;
end Main;
