-------------------------------------------------------------------------------
-- (C) Altran Praxis Limited
-------------------------------------------------------------------------------
--
-- The SPARK toolset is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
-- Software Foundation; either version 3, or (at your option) any later
-- version. The SPARK toolset is distributed in the hope that it will be
-- useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
-- Public License for more details. You should have received a copy of the GNU
-- General Public License distributed with the SPARK toolset; see file
-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy of
-- the license.
--
--=============================================================================

with Ada.Real_Time;
with Ada.Text_IO;
with Ada.IO_Exceptions;
with Ada.Strings.Fixed;
with Ada.Characters;
with Ada.Characters.Latin_1;

with GNAT.Regpat;
with GNAT.Directory_Operations;
with GNAT.OS_Lib;

with Utility;
with Wrap;
with CMD;
with Work_Manager;
with SPARK.Expect;

use type Ada.Real_Time.Time;

use type GNAT.OS_Lib.String_Access;
use type GNAT.OS_Lib.Argument_List;
use type GNAT.Regpat.Match_Location;

use type SPARK.Expect.Process_Descriptor_Access;
use type SPARK.Expect.Expect_Match;
use type Work_Manager.AnalysisType;

package body Workers
is

   Simplifier_Options  : GNAT.OS_Lib.Argument_List_Access;
   ZombieScope_Options : GNAT.OS_Lib.Argument_List_Access;
   Victor_Options      : GNAT.OS_Lib.Argument_List_Access;
   Riposte_Options     : GNAT.OS_Lib.Argument_List_Access;

   Pat : constant GNAT.Regpat.Pattern_Matcher :=
     GNAT.Regpat.Compile ("^.*\n", GNAT.Regpat.Multiple_Lines);

   Pat_Access : constant SPARK.Expect.Pattern_Matcher_Access :=
     new GNAT.Regpat.Pattern_Matcher'(Pat);

   procedure Locate_Binaries
   is
   begin
      Path := GNAT.OS_Lib.Getenv ("PATH");

      if Path = null then
         Path := GNAT.OS_Lib.Getenv ("path");
      end if;

      -- Find Simplifier binary - check -x switch first.
      -- If that's not specified, then look on PATH
      if CMD.Simplifier_Exe_Switch /= null then
         --  simplifer executable specified by -x= switch
         Spadesimp_Exe := GNAT.OS_Lib.Locate_Exec_On_Path
           (CMD.Simplifier_Exe_Switch.all);
      else
         if Path = null then
            Ada.Text_IO.Put_Line
              ("Error: can't find PATH environment variable");
            Spadesimp_Exe := null;
         else
            Spadesimp_Exe := GNAT.OS_Lib.Locate_Exec_On_Path
              (Spadesimp_Command);
         end if;
      end if;

      if CMD.ZombieScope_Exe_Switch /= null then
         -- ZombieScope executable specified by -z= switch
         ZombieScope_Exe := GNAT.OS_Lib.Locate_Exec_On_Path
           (CMD.ZombieScope_Exe_Switch.all);
      else
         if Path = null then
            Ada.Text_IO.Put_Line
              ("Error: can't find PATH environment variable");
            ZombieScope_Exe := null;
         else
            ZombieScope_Exe := GNAT.OS_Lib.Locate_Exec_On_Path
              (ZombieScope_Command);
         end if;
      end if;

      if CMD.Victor_Exe_Switch /= null then
         -- Victor executable specified by -c= switch
         Victor_Exe := GNAT.OS_Lib.Locate_Exec_On_Path
           (CMD.Victor_Exe_Switch.all);
      else
         if Path = null then
            Ada.Text_IO.Put_Line
              ("Error: can't find PATH environment variable");
            Victor_Exe := null;
         else
            Victor_Exe := GNAT.OS_Lib.Locate_Exec_On_Path
              (Victor_Command);
         end if;
      end if;

      if Path = null then
         Riposte_Exe := null;
         Python_Exe  := null;
      else
         Riposte_Exe := GNAT.OS_Lib.Locate_Exec_On_Path (Riposte_Command);
         Python_Exe  := GNAT.OS_Lib.Locate_Exec_On_Path (Python_Command);
      end if;

   end Locate_Binaries;

   procedure Initialize
     (Work_Set  : in out Worker_Set;
      S_Options : in     GNAT.OS_Lib.Argument_List_Access;
      Z_Options : in     GNAT.OS_Lib.Argument_List_Access;
      V_Options : in     GNAT.OS_Lib.Argument_List_Access;
      R_Options : in     GNAT.OS_Lib.Argument_List_Access)
   is
   begin
      Locate_Binaries;

      Simplifier_Options     := S_Options;
      ZombieScope_Options    := Z_Options;
      Victor_Options         := V_Options;
      Riposte_Options        := R_Options;

      Work_Set.Worker_Count  := Work_Set.Procs'Length;
      Work_Set.Working_Count := 0;
      for I in Work_Set.Procs'Range loop
         Work_Set.Procs (I) := SPARK.Expect.Multiprocess_Regexp'
           (Descriptor => null,
            Regexp     => Pat_Access);
      end loop;
      --  No need to initialize Work_Set.Files (access to it is controlled
      --  by Working_Count).
      Log_Files.Initialize (Work_Set.Logs);
   end Initialize;

   procedure Start_Analysis (The_Job  : in     Work_Manager.Job_Index;
                             Work_Set : in out Worker_Set)
   is

      procedure Create_Log_File (For_Worker : Natural);

      Worker : Natural;

      On_File : constant String :=
        Work_Manager.Jobs.Get_File_Name (The_Job);

      --  Find the first directory separator from the right hand
      --  end of File_Name, so we can split into the directory,
      --  and the plain file name
      Dir_Index : constant Natural := Ada.Strings.Fixed.Index
        (On_File,
         Utility.String_1'(1 => GNAT.OS_Lib.Directory_Separator),
         Ada.Strings.Backward);

      --  Directory in which to run simplifier
      Dir : constant String := On_File (1 .. Dir_Index);

      --  Simple file name of file to be processed, with 4-char suffix
      --  (e.g. ".vcg" or ".dpc") removed
      Simple_File_Name : aliased constant String := Work_Manager.Jobs.Get_Simple_File_Name (The_Job);

      SF  : constant GNAT.OS_Lib.String_Access := new String'(Simple_File_Name);

      Simplifier_Expect_Args : constant GNAT.OS_Lib.Argument_List :=
        (1 => SF) & Simplifier_Options.all;

      ZombieScope_Expect_Args : constant GNAT.OS_Lib.Argument_List :=
        (1 => SF) & ZombieScope_Options.all;

      Victor_Expect_Args : constant GNAT.OS_Lib.Argument_List :=
        (1 => SF) & Victor_Options.all;

      --  See note below in Start_Analysis why this is different.
      Riposte_Expect_Args : constant GNAT.OS_Lib.Argument_List :=
        (1 => Riposte_Exe,
         2 => SF) & Riposte_Options.all;

      procedure Create_Log_File (For_Worker : Natural)
      is
         OK       : Boolean := False;
         Suffix   : Utility.String_3;
      begin
         -- Decide the correct suffix
         if Utility.Is_A_VCG_File (On_File) then
            Suffix := "log";
         else
            Suffix := "zsl";
         end if;

         declare
            Log_File : constant String :=
              On_File (1 .. On_File'Last - 3) & Suffix;
         begin
            loop
               begin
                  Log_Files.Open (Log_File,
                                  Work_Set.Files (For_Worker).OP,
                                  Work_Set.Logs);
                  OK := True;
               exception
                  when Ada.IO_Exceptions.Use_Error |
                    Ada.IO_Exceptions.Name_Error =>
                     Ada.Text_IO.Put_Line ("Create failed - trying again...");
                     OK := False;
               end;
               exit when OK;
            end loop;
         end;

      end Create_Log_File;

      FD_Access : constant SPARK.Expect.Process_Descriptor_Access :=
        new SPARK.Expect.Process_Descriptor;
      Job_Type : Work_Manager.AnalysisType;
      -- Result : SPARK.Expect.Expect_Match;

   begin  -- Start_Analysis

      Job_Type := Work_Manager.Jobs.Get_Analysis_Type (The_Job);
      Work_Set.Working_Count := Work_Set.Working_Count + 1;
      Worker := Work_Set.Working_Count;
      if CMD.Log_Output and Job_Type /= Work_Manager.Victor then -- and this particlular job is not a victor job
         Create_Log_File (Worker);
      end if;

      declare
         FN      : constant String :=
           Work_Manager.Jobs.Get_File_Name (The_Job);
         Job_Str : constant String := Utility.Format_Int (Item  => The_Job,
                                                          Width => 6);
      begin
         --  Print a message to indicate the job has started.
         Ada.Text_IO.Put_Line
           (Job_Str & " Started - " & Work_Manager.AnalysisType'Image (Job_Type) & " - " & FN);

         --  Create a Process_Descriptor that can be accessed via a
         --  Process_Descriptor_Access.  If one already exists then it was
         --  created for a previous simplification and recycled in Compact.
         --  This ensures that only the minimum number of objects are created
         --  on the heap and we don't need to worry about Free'ing them.
         if Work_Set.Procs (Worker).Descriptor = null then
            Work_Set.Procs (Worker).Descriptor :=
              new SPARK.Expect.Process_Descriptor;
         end if;

         Work_Set.Files (Worker).Start_Time := Ada.Real_Time.Clock;
         GNAT.Directory_Operations.Change_Dir (Dir);

         -- if Is_A_VCG_File (FN) then
         case Job_Type is
            when Work_Manager.Simplify =>
               SPARK.Expect.Non_Blocking_Spawn (FD_Access.all,
                                                Spadesimp_Exe.all,
                                                Simplifier_Expect_Args,
                                                0,
                                                False);
            when Work_Manager.Zombiescope =>
               SPARK.Expect.Non_Blocking_Spawn (FD_Access.all,
                                                ZombieScope_Exe.all,
                                                ZombieScope_Expect_Args,
                                                0,
                                                False);
            when Work_Manager.Victor =>
               SPARK.Expect.Non_Blocking_Spawn (FD_Access.all,
                                                Victor_Exe.all,
                                                Victor_Expect_Args,
                                                0,
                                                True);
            when Work_Manager.Riposte =>
               --  Note that this invocation is different to the other
               --  tools above; we say "python riposte.py <args>"
               --  instead of "riposte.py <args>".  The reason for
               --  this that on Windows spawning processes is
               --  different from a shell invocation.  The chosen
               --  workaround is portable on all supported platforms.
               SPARK.Expect.Non_Blocking_Spawn (FD_Access.all,
                                                Python_Exe.all,
                                                Riposte_Expect_Args,
                                                0,
                                                True);
         end case;

      end;


      Work_Set.Procs (Worker).Descriptor := FD_Access;
      Work_Set.Files (Worker).Job_ID     := The_Job;
      Work_Set.Files (Worker).OK         := True;
      Work_Set.Files (Worker).WhyFailed  := Work_Manager.NullErrorString;
   end Start_Analysis;

   function Workers_Available (Work_Set : Worker_Set) return Natural
   is
   begin
      return Work_Set.Worker_Count - Work_Set.Working_Count;
   end Workers_Available;

   procedure Run_Analysis (Work_Set : in out Worker_Set)
   is

      procedure Compact (Removing : in Positive);

      procedure Close_Log_File;

      Result        : SPARK.Expect.Expect_Match;
      Never_Timeout : constant Integer := -1;
      Worker        : Natural;
      Job_ID        : Work_Manager.Job_Index;

      procedure Close_Log_File
      is
         OK : Boolean := False;
      begin
         loop
            begin
               Log_Files.Close (Work_Set.Files (Worker).OP,
                                Work_Set.Logs);
               OK := True;
            exception
               when Ada.IO_Exceptions.Device_Error =>
                  --  if OP is still open, then try again!
                  if Ada.Text_IO.Is_Open
                    (Log_Files.File_Type (Work_Set.Files (Worker).OP,
                                          Work_Set.Logs).all)
                  then
                     Ada.Text_IO.Put_Line
                       ("Close failed with Device_Error - try again...");
                     OK := False;
                  else
                     Ada.Text_IO.Put_Line
                       ("Close failed with Device_Error - aborting...");
                     OK := True;
                  end if;
               when Storage_Error =>
                  Ada.Text_IO.Put_Line
                    ("Close failed with Storage_Error - aborting...");
                  OK := True;
            end;
            exit when OK;
         end loop;
      end Close_Log_File;

      procedure Compact (Removing : in Positive)
      is
         --  We need to preserve the pointer to the process descriptor
         --  so that it can be re-used in a later simplification.
         PD_Acc : constant SPARK.Expect.Process_Descriptor_Access :=
           Work_Set.Procs (Removing).Descriptor;
      begin
         for I in Removing .. Work_Set.Working_Count - 1 loop
            Work_Set.Files (I) := Work_Set.Files (I + 1);
            Work_Set.Procs (I) := Work_Set.Procs (I + 1);
         end loop;
         Work_Set.Procs (Work_Set.Working_Count).Descriptor := PD_Acc;
         Work_Set.Working_Count := Work_Set.Working_Count - 1;
      end Compact;

      ---------------------------------------------------------
      --  This string is prodced by the Simplifier at the start
      --  of a line to signal a critical error.  This string
      --  must match that in spade/simplifier/src/utilities.pl
      --  in the clause write_error_preamble/0
      ---------------------------------------------------------
      Error_Preamble : constant String := "*** ERROR - ";

   begin  --  Code of Run_Analysis
      loop
         SPARK.Expect.Expect (Result,
                              Worker,
                              Work_Set.Procs (1 .. Work_Set.Working_Count),
                              Never_Timeout);
         if Result in 1 .. SPARK.Expect.Expect_Match (Work_Set.Working_Count) then
            Worker := Integer (Result);
            declare
               S : constant String :=
                 SPARK.Expect.Expect_Out_Match
                 (Work_Set.Procs (Worker).Descriptor.all);
               Final_Char : Natural;
            begin
               Job_ID := Work_Set.Files (Worker).Job_ID;

               --  On NT, we want to turn the CR/LF sequence
               --  coming from the Simplifier back into a
               --  standard line-ending sequence, so...
               if S'Length >= 2 and then
                 (S (S'Last) = Ada.Characters.Latin_1.LF and
                    S (S'Last - 1) = Ada.Characters.Latin_1.CR) then

                  Final_Char := S'Last - 2;

                  --  On Other platforms, the line might end in just
                  --  a single LF, so strip that as well if the case
                  --  above didn't apply.
               elsif S'Length >= 1 and then
                 S (S'Last) = Ada.Characters.Latin_1.LF then

                  Final_Char := S'Last - 1;

               else
                  Final_Char := S'Last;
               end if;

               if CMD.Log_Output and Work_Manager.Jobs.Get_Analysis_Type (Job_ID) /= Work_Manager.Victor then
                  --  wrap each line to the log file
                  Wrap.CopyAndMaybeWrapLine
                    (Log_Files.File_Type (Work_Set.Files (Worker).OP,
                                          Work_Set.Logs).all,
                     S (S'First .. Final_Char));
               end if;

               if CMD.Echo_Output then
                  Wrap.CopyAndMaybeWrapLine
                    (Ada.Text_IO.Standard_Output,
                     S (S'First .. Final_Char));
               end if;

               --  if an error is found pass out why
               if S'Length >= Error_Preamble'Length and then
                 S (1 .. Error_Preamble'Length) = Error_Preamble then
                  Work_Set.Files (Worker).OK := False;
                  if S'Length <= Work_Manager.MaxErrorStringIndex then
                     Work_Set.Files (Worker).WhyFailed (1 .. S'Length) := S;
                  else
                     Work_Set.Files (Worker).WhyFailed :=
                       S (1 .. Work_Manager.MaxErrorStringIndex);
                  end if;
               end if;
            end;

         elsif Result = SPARK.Expect.Expect_Timeout then
            --  Timeout is OK - go round again...
            Utility.Debug ("Expect timeout");

         elsif Result = SPARK.Expect.Expect_Full_Buffer then
            Utility.Debug ("Expect Full Buffer");
            exit;

         elsif Result = SPARK.Expect.Expect_Process_Died then
            Utility.Debug ("Expect Process Died with Worker = " &
                             Integer'Image (Worker));
            exit;

         else
            Utility.Debug ("Got an unexpected exception from Expect");
            exit;
         end if;
      end loop;

      --  Tidy up when an analysis has finished.
      if Worker = 0 then
         --  Exit from Run_Analysis with error message;
         Utility.Debug ("Can't find completed Simplifier process.");
         return;
      end if;
      Job_ID := Work_Set.Files (Worker).Job_ID;

      Work_Set.Files (Worker).End_Time := Ada.Real_Time.Clock;
      Work_Set.Files (Worker).Elapsed_Time :=
        Ada.Real_Time.To_Duration (Work_Set.Files (Worker).End_Time -
                                     Work_Set.Files (Worker).Start_Time);

      SPARK.Expect.Close (Work_Set.Procs (Worker).Descriptor.all);

      if CMD.Log_Output and Work_Manager.Jobs.Get_Analysis_Type (Job_ID) not in Work_Manager.Logless_Job then
         Utility.Debug ("Closing Log File");
         Close_Log_File;
      end if;

      --  If we are a simplification job, follow up with Victor and Riposte.
      if Work_Manager.Jobs.Get_Analysis_Type (Job_ID) = Work_Manager.Simplify then
         if CMD.Run_Victor then
            Work_Manager.Jobs.Add_Work_Package
              (Work_Manager.Jobs.Get_File_Name
                 (Work_Set.Files (Worker).Job_ID), Work_Manager.Victor);
         end if;
         if CMD.Run_Riposte then
            Work_Manager.Jobs.Add_Work_Package
              (Work_Manager.Jobs.Get_File_Name
                 (Work_Set.Files (Worker).Job_ID), Work_Manager.Riposte);
         end if;
      end if;

      Utility.Debug ("Worker is " & Integer'Image (Worker));
      Utility.Debug ("Job_ID is " & Integer'Image (Job_ID));

      if Work_Set.Files (Worker).OK then
         Work_Manager.Jobs.JobFinished (Job_ID);
      else
         Work_Manager.Jobs.JobFailed (Job_ID,
                                      Work_Set.Files (Worker).WhyFailed);
      end if;

      --  Display a message that the job is finished.
      declare
         Job_Str : constant String := Utility.Format_Int (Item  => Job_ID,
                                                          Width => 6);
      begin
         Utility.Put_Message_With_Duration (Message => Job_Str & " Finished ",
                                            D       => Work_Set.Files (Worker).Elapsed_Time);
      end;

      Compact (Removing => Worker);

   end Run_Analysis;

end Workers;
