-------------------------------------------------------------------------------
-- (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.
--
--=============================================================================

separate (ErrorHandler)
package body ErrorBuffer
--# own Buffer is Current_Flow_Error,
--#               The_Buffer;
is

   subtype Buff_Index is Integer range 1 .. ExaminerConstants.ErrorBufferSize;
   subtype Buff_Ptr is Integer range 0 .. ExaminerConstants.ErrorBufferSize;
   type Error_Array is array (Buff_Index) of Error_Types.NumericError;
   type Buffers is record
      ErrorList : Error_Array;
      ErrPtr    : Buff_Ptr;
   end record;

   The_Buffer : Buffers;

   Current_Flow_Error : Error_Types.NumericError;

   --------------------------------------------------------------------------
   --                      Local Procedures
   --------------------------------------------------------------------------

   function Null_Error return  Error_Types.NumericError
   --# global in Dictionary.Dict;
   is
   begin
      return Error_Types.NumericError'
        (ErrorType => Error_Types.NoErr,
         Position  => LexTokenManager.Token_Position'(Start_Line_No => 0,
                                                      Start_Pos     => 0),
         Scope     => Dictionary.GlobalScope,
         ErrorNum  => 0,
         Reference => 0,
         Name1     => Error_Types.NoName,
         Name2     => Error_Types.NoName,
         Name3     => Error_Types.NoName);
   end Null_Error;

   --------------------------------------------------------------------------
   --                      Exported Procedures
   --------------------------------------------------------------------------

   procedure Flush (Err_File : in out Error_IO.File_Type)
   --# global in     Dictionary.Dict;
   --#        in out SPARK_IO.File_Sys;
   --#        in out The_Buffer;
   --# derives Err_File          from *,
   --#                                SPARK_IO.File_Sys,
   --#                                The_Buffer &
   --#         SPARK_IO.File_Sys from *,
   --#                                Dictionary.Dict,
   --#                                Err_File,
   --#                                The_Buffer &
   --#         The_Buffer        from ;
   is

      function Is_Less_Than (One, Two : LexTokenManager.Token_Position) return Boolean is
         Less_Than : Boolean;
      begin
         if One.Start_Line_No = Two.Start_Line_No then
            Less_Than := One.Start_Pos < Two.Start_Pos;
         else
            Less_Than := One.Start_Line_No < Two.Start_Line_No;
         end if;
         return Less_Than;
      end Is_Less_Than;

      --------------------------

      procedure Sort_Buff
      --# global in out The_Buffer;
      --# derives The_Buffer from *;
      is

         procedure Swap (X, Y : in Buff_Ptr)
         --# global in out The_Buffer;
         --# derives The_Buffer from *,
         --#                         X,
         --#                         Y;
         is
            T : Error_Types.NumericError;
         begin
            T                        := The_Buffer.ErrorList (X);
            The_Buffer.ErrorList (X) := The_Buffer.ErrorList (Y);
            The_Buffer.ErrorList (Y) := T;
         end Swap;

      begin --Sort_Buff
         for I in Buff_Ptr range 1 .. The_Buffer.ErrPtr loop
            for J in Buff_Ptr range I .. The_Buffer.ErrPtr loop
               if Is_Less_Than (One => The_Buffer.ErrorList (J).Position,
                                Two => The_Buffer.ErrorList (I).Position) then
                  Swap (X => I,
                        Y => J);
               end if;
            end loop;
         end loop;
      end Sort_Buff;

      ------------------------------------------

      procedure Merge
      --# global in     Dictionary.Dict;
      --#        in     The_Buffer;
      --#        in out Err_File;
      --#        in out SPARK_IO.File_Sys;
      --# derives Err_File          from *,
      --#                                SPARK_IO.File_Sys,
      --#                                The_Buffer &
      --#         SPARK_IO.File_Sys from *,
      --#                                Dictionary.Dict,
      --#                                Err_File,
      --#                                The_Buffer;
      is
         New_File              : Error_IO.File_Type;
         Ptr                   : Buff_Ptr;
         Buf_Empty, File_Empty : Boolean;
         Buf_Ent, File_Ent     : Error_Types.NumericError;

         --------------------------------------------------------------------------

         procedure Create_Temp (F : out Error_IO.File_Type)
         --# global in out SPARK_IO.File_Sys;
         --# derives F,
         --#         SPARK_IO.File_Sys from SPARK_IO.File_Sys;
         is
            OK      : SPARK_IO.File_Status;
            Local_F : Error_IO.File_Type := Error_IO.Null_File;
         begin
            Error_IO.Create (Local_F, OK);
            if OK /= SPARK_IO.Ok then
               SystemErrors.Fatal_Error
                 (Sys_Err => SystemErrors.Error_Handler_Temporary_Files,
                  Msg     => "in ErrorBuffer.Create_Temp");
            end if;
            F := Local_F;
         end Create_Temp;

         --------------------------------------------------------------------------

         procedure Reset_Temp (F : in out Error_IO.File_Type)
         --# global in out SPARK_IO.File_Sys;
         --# derives F,
         --#         SPARK_IO.File_Sys from *,
         --#                                F;
         is
            OK : SPARK_IO.File_Status;
         begin
            Error_IO.Reset (F, SPARK_IO.In_File, OK);
            if OK /= SPARK_IO.Ok then
               SystemErrors.Fatal_Error
                 (Sys_Err => SystemErrors.Error_Handler_Temporary_Files,
                  Msg     => "in ErrorBuffer.Reset_Temp");
            end if;
         end Reset_Temp;

         --------------------------------------------------------------------------

         procedure Close_Temp (F : in out Error_IO.File_Type)
         --# global in out SPARK_IO.File_Sys;
         --# derives F,
         --#         SPARK_IO.File_Sys from *,
         --#                                F;
         is
            OK : SPARK_IO.File_Status;
         begin
            Error_IO.Close (F, OK);
            if OK /= SPARK_IO.Ok then
               SystemErrors.Fatal_Error
                 (Sys_Err => SystemErrors.Error_Handler_Temporary_Files,
                  Msg     => "in ErrorBuffer.Close_Temp");
            end if;
         end Close_Temp;

         --------------------------------------------------------------------------

         procedure Get_Buffer_Entry (Ent   : out Error_Types.NumericError;
                                     Empty : out Boolean)
         --# global in     Dictionary.Dict;
         --#        in     The_Buffer;
         --#        in out Ptr;
         --# derives Empty,
         --#         Ptr   from Ptr,
         --#                    The_Buffer &
         --#         Ent   from Dictionary.Dict,
         --#                    Ptr,
         --#                    The_Buffer;
         is
         begin
            if Ptr = The_Buffer.ErrPtr then
               Ent   := Null_Error;
               Empty := True;
            else
               Ptr   := Ptr + 1;
               Ent   := The_Buffer.ErrorList (Ptr);
               Empty := False;
            end if;
         end Get_Buffer_Entry;

      begin --Merge
         Ptr := 0;
         Get_Buffer_Entry (Ent   => Buf_Ent,
                           Empty => Buf_Empty);
         if not Buf_Empty then --only merge sort if buffer contains some entries
            Create_Temp (F => New_File);
            Reset_Temp (F => Err_File);

            Error_IO.Get_Numeric_Error (Err_File, File_Ent);
            File_Empty := (File_Ent = Error_Types.Empty_NumericError);

            while not (Buf_Empty and File_Empty) loop
               if File_Empty then
                  Error_IO.Put_Numeric_Error (New_File, Buf_Ent);
                  Get_Buffer_Entry (Ent   => Buf_Ent,
                                    Empty => Buf_Empty);
               elsif Buf_Empty then
                  Error_IO.Put_Numeric_Error (New_File, File_Ent);
                  Error_IO.Get_Numeric_Error (Err_File, File_Ent);
                  File_Empty := (File_Ent = Error_Types.Empty_NumericError);

               else --neither empty
                  if Is_Less_Than (One => Buf_Ent.Position,
                                   Two => File_Ent.Position) then
                     Error_IO.Put_Numeric_Error (New_File, Buf_Ent);
                     Get_Buffer_Entry (Ent   => Buf_Ent,
                                       Empty => Buf_Empty);
                  else
                     Error_IO.Put_Numeric_Error (New_File, File_Ent);
                     Error_IO.Get_Numeric_Error (Err_File, File_Ent);
                     File_Empty := (File_Ent = Error_Types.Empty_NumericError);

                  end if;
               end if;
            end loop;
            --# accept Flow, 10, Err_File, "Expected ineffective assignment";
            Close_Temp (F => Err_File);
            --# end accept;
            Err_File := New_File;
         end if;
      end Merge;

      ------------------------------------------

      procedure Init_Buff
      --# global out The_Buffer;
      --# derives The_Buffer from ;
      is
      begin
         The_Buffer.ErrPtr := 0;
         --intentional failure to initialize array will cause flow error here
         --# accept F, 31, The_Buffer.ErrorList, "Intentional incomplete initialization" &
         --#        F, 32, The_Buffer.ErrorList, "Intentional incomplete initialization" &
         --#        F, 602, The_Buffer, The_Buffer.ErrorList, "Intentional incomplete initialization";
      end Init_Buff; -- Init. is partial but effecive.  Expect 2 errs + 1 warning

   begin -- Flush
      Sort_Buff;
      Merge;
      Init_Buff;
   end Flush;

   --------------------------------------------------------------------------

   procedure Add
     (Err_File            : in out Error_IO.File_Type;
      Err_Type            : in     Error_Types.Error_Class;
      Pos                 : in     LexTokenManager.Token_Position;
      Scope               : in     Dictionary.Scopes;
      Error_Number        : in     Natural;
      Reference           : in     Natural;
      Name1, Name2, Name3 : in     Error_Types.Names;
      Echo_Str            :    out Error_Types.StringError)
   --# global in     CommandLineData.Content;
   --#        in     Dictionary.Dict;
   --#        in     LexTokenManager.State;
   --#        in out Conversions.State;
   --#        in out Current_Flow_Error;
   --#        in out SPARK_IO.File_Sys;
   --#        in out The_Buffer;
   --# derives Conversions.State,
   --#         The_Buffer         from *,
   --#                                 CommandLineData.Content,
   --#                                 Current_Flow_Error,
   --#                                 Error_Number,
   --#                                 Err_Type,
   --#                                 Name1,
   --#                                 Name2,
   --#                                 Name3,
   --#                                 Pos,
   --#                                 Reference,
   --#                                 Scope &
   --#         Current_Flow_Error from *,
   --#                                 CommandLineData.Content,
   --#                                 Dictionary.Dict,
   --#                                 Error_Number,
   --#                                 Err_Type,
   --#                                 Name1,
   --#                                 Name2,
   --#                                 Name3,
   --#                                 Pos,
   --#                                 Reference,
   --#                                 Scope &
   --#         Echo_Str           from CommandLineData.Content,
   --#                                 Conversions.State,
   --#                                 Current_Flow_Error,
   --#                                 Dictionary.Dict,
   --#                                 Error_Number,
   --#                                 Err_Type,
   --#                                 LexTokenManager.State,
   --#                                 Name1,
   --#                                 Name2,
   --#                                 Name3,
   --#                                 Pos,
   --#                                 Reference,
   --#                                 Scope &
   --#         Err_File           from *,
   --#                                 CommandLineData.Content,
   --#                                 Current_Flow_Error,
   --#                                 Error_Number,
   --#                                 Err_Type,
   --#                                 Name1,
   --#                                 Name2,
   --#                                 Name3,
   --#                                 Pos,
   --#                                 Reference,
   --#                                 Scope,
   --#                                 SPARK_IO.File_Sys,
   --#                                 The_Buffer &
   --#         SPARK_IO.File_Sys  from *,
   --#                                 CommandLineData.Content,
   --#                                 Current_Flow_Error,
   --#                                 Dictionary.Dict,
   --#                                 Error_Number,
   --#                                 Err_File,
   --#                                 Err_Type,
   --#                                 Name1,
   --#                                 Name2,
   --#                                 Name3,
   --#                                 Pos,
   --#                                 Reference,
   --#                                 Scope,
   --#                                 The_Buffer;
   is
      New_Entry : Error_Types.NumericError;

      procedure Set_To_New_Errors (New_Entry : in out Error_Types.NumericError)
      --# derives New_Entry from *;
      is
      begin
         if (New_Entry.ErrorNum = ErrorHandler.Dependency_Err_Number (Err_Type => ErrorHandler.May_Be_Used) and
               New_Entry.ErrorType = Error_Types.CondlDependencyErr) then
            New_Entry.ErrorNum := ErrorHandler.Dependency_Err_Number (Err_Type => ErrorHandler.May_Be_Used_New);
         elsif (New_Entry.ErrorNum = ErrorHandler.Dependency_Err_Number (Err_Type => ErrorHandler.Not_Used) and
                  New_Entry.ErrorType = Error_Types.UncondDependencyErr) then
            New_Entry.ErrorNum := ErrorHandler.Dependency_Err_Number (Err_Type => ErrorHandler.Not_Used_New);
         end if;

      end Set_To_New_Errors;

      procedure Reset_Error_Num (Err_Num : in out Error_Types.NumericError)
      --# global in     Dictionary.Dict;
      --#        in out Current_Flow_Error;
      --# derives Current_Flow_Error from *,
      --#                                 Dictionary.Dict,
      --#                                 Err_Num &
      --#         Err_Num            from *,
      --#                                 Current_Flow_Error;
      is
      begin
         case Err_Num.ErrorType is
            when Error_Types.UncondDependencyErr =>
               if Err_Num.ErrorNum = ErrorHandler.Dependency_Err_Number (Err_Type => ErrorHandler.Not_Used_New) then
                  if Current_Flow_Error.ErrorNum = ErrorHandler.Dependency_Err_Number (Err_Type => ErrorHandler.Not_Used_New)
                    and then (Err_Num.Name2 = Current_Flow_Error.Name2 and
                                Err_Num.Scope = Current_Flow_Error.Scope and
                                Err_Num.Position = Current_Flow_Error.Position) then
                     -- Continuation
                     Err_Num.ErrorNum := ErrorHandler.Dependency_Err_Number (Err_Type => ErrorHandler.Not_Used_Continue);
                  else
                     -- New Error;
                     Current_Flow_Error := Err_Num;
                  end if;
               else
                  Current_Flow_Error := Null_Error;
               end if;

            when Error_Types.CondlDependencyErr =>
               if Err_Num.ErrorNum = ErrorHandler.Dependency_Err_Number (Err_Type => ErrorHandler.May_Be_Used_New) then
                  if Current_Flow_Error.ErrorNum = ErrorHandler.Dependency_Err_Number (Err_Type => ErrorHandler.May_Be_Used_New)
                    and then (Err_Num.Name2 = Current_Flow_Error.Name2 and
                                Err_Num.Scope = Current_Flow_Error.Scope and
                                Err_Num.Position = Current_Flow_Error.Position) then
                     -- Continuation
                     Err_Num.ErrorNum := ErrorHandler.Dependency_Err_Number (Err_Type => ErrorHandler.May_Be_Used_Continue);
                  else
                     -- New Error;
                     Current_Flow_Error := Err_Num;
                  end if;
               else
                  Current_Flow_Error := Null_Error;
               end if;

            when others =>
               Current_Flow_Error := Null_Error;
         end case;
      end Reset_Error_Num;

   begin
      New_Entry :=
        Error_Types.NumericError'
        (ErrorType => Err_Type,
         Position  => Pos,
         Scope     => Scope,
         ErrorNum  => Error_Number,
         Reference => Reference,
         Name1     => Name1,
         Name2     => Name2,
         Name3     => Name3);
      if not CommandLineData.Content.Legacy_Errors then
         Set_To_New_Errors (New_Entry => New_Entry);
      end if;
      Reset_Error_Num (Err_Num => New_Entry);
      Conversions.ToString (New_Entry, Error_Types.ForScreen, Echo_Str);
      The_Buffer.ErrPtr                        := The_Buffer.ErrPtr + 1;
      The_Buffer.ErrorList (The_Buffer.ErrPtr) := New_Entry;
      if The_Buffer.ErrPtr = ExaminerConstants.ErrorBufferSize then
         Flush (Err_File => Err_File);
      end if;
   end Add;

begin --init
   The_Buffer.ErrPtr            := 0;
   Current_Flow_Error.ErrorType := Error_Types.NoErr;
   Current_Flow_Error.Position  := LexTokenManager.Token_Position'(Start_Line_No => 0,
                                                                   Start_Pos     => 0);
   Current_Flow_Error.ErrorNum  := 0;
   Current_Flow_Error.Reference := 0;
   Current_Flow_Error.Name1     := Error_Types.NoName;
   Current_Flow_Error.Name2     := Error_Types.NoName;
   Current_Flow_Error.Name3     := Error_Types.NoName;
   --intentional non-initialization of array will cause flow error here
   --# accept F, 31, The_Buffer.ErrorList, "Intentional incomplete initialization" &
   --#        F, 32, The_Buffer.ErrorList, "Intentional incomplete initialization" &
   --#        F, 602, The_Buffer, The_Buffer.ErrorList, "Intentional incomplete initialization" &
   --#        F, 31, Current_Flow_Error.Scope, "Intentional incomplete initialization" &
   --#        F, 32, Current_Flow_Error.Scope, "Intentional incomplete initialization" &
   --#        F, 602, Current_Flow_Error, Current_Flow_Error.Scope, "Intentional incomplete initialization";
end ErrorBuffer; -- Init. is partial but effective.  Expect 4 errs + 2 warnings.
