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

--------------------------------------------------------------------------------
--Synopsis:                                                                   --
--                                                                            --
--Package providing a structure in which to store VC details.                 --
--                                                                            --
--To be used in tandem with the Heap data structure, hence the use of         --
--Heap.Atom as the array range                                                --
--------------------------------------------------------------------------------

package body VCDetails is

   procedure Add
     (Details    : in out Data_Type;
      Index      :    out HeapIndex.IndexType;
      Success    :    out Boolean;
      Name       : in     E_Strings.T;
      Path_Start : in     E_Strings.T;
      Path_End   : in     E_Strings.T;
      End_Type   : in     Terminal_Point_Type;
      VC_State   : in     VC_State_T;
      DPC_State  : in     DPC_State_T)
   is
   begin
      if Details.High_Mark < HeapIndex.IndexType'Last then
         Success                             := True;
         Details.High_Mark                   := Details.High_Mark + 1;
         Index                               := Details.High_Mark;
         Details.Details (Details.High_Mark) := Details_Element'(Name, Path_Start, Path_End, End_Type, VC_State, DPC_State);
      else
         Success := False;
         Index   := 0;
      end if;
   end Add;

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

   procedure Initialize (Details : out Data_Type) is
   begin
      -- Only set HighMark here.  Initializing the whole array is
      -- unnecessary here, and is VERY SLOW on machines with limited
      -- RAM likes VAXes, where the initialization causes massive
      -- VM thrashing.
      Details.High_Mark := 0;
      -- Also set that no error has been seen.
      Details.Error_Status := Error_Array'(others => False);

      --# accept F, 31, Details.Details, "Partial initialization" &
      --#        F, 32, Details.Details, "Partial initialization" &
      --#        F, 602, Details, Details.Details, "Partial initialization";
   end Initialize;

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

   procedure Raise_Error (Error_Kind : in     Error_Type;
                          Details    : in out Data_Type) is
   begin
      Details.Error_Status (Error_Kind) := True;
   end Raise_Error;

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

   function Error_Raised (Error_Kind : in Error_Type;
                          Details    : in Data_Type) return Boolean is
   begin
      return Details.Error_Status (Error_Kind);
   end Error_Raised;

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

   procedure Set_VC_State (Details  : in out Data_Type;
                           Index    : in     HeapIndex.IndexType;
                           VC_State : in     VC_State_T) is
   begin
      Details.Details (Index).VC_State := VC_State;
   end Set_VC_State;

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

   function Get_VC_State (Details : in Data_Type;
                          Index   : in HeapIndex.IndexType) return VC_State_T is
   begin
      return Details.Details (Index).VC_State;
   end Get_VC_State;

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

   procedure Set_DPC_State (Details   : in out Data_Type;
                            Index     : in     HeapIndex.IndexType;
                            DPC_State : in     DPC_State_T) is
   begin
      Details.Details (Index).DPC_State := DPC_State;
   end Set_DPC_State;

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

   function Get_DPC_State (Details : in Data_Type;
                           Index   : in HeapIndex.IndexType) return DPC_State_T is
   begin
      return Details.Details (Index).DPC_State;
   end Get_DPC_State;

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

   procedure Order (First_Name  : in     E_Strings.T;
                    Second_Name : in     E_Strings.T;
                    Result      :    out E_Strings.Order_Types) is
   begin
      -- check which name comes first
      if E_Strings.Get_Length (E_Str => First_Name) = E_Strings.Get_Length (E_Str => Second_Name) then
         Result := E_Strings.Lex_Order (First_Name  => First_Name,
                                        Second_Name => Second_Name);
      elsif E_Strings.Get_Length (E_Str => First_Name) < E_Strings.Get_Length (E_Str => Second_Name) then
         Result := E_Strings.First_One_First;
      else
         Result := E_Strings.Second_One_First;
      end if;
   end Order;

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

   procedure Retrieve
     (Details    : in     Data_Type;
      Index      : in     HeapIndex.IndexType;
      Success    :    out Boolean;
      Name       :    out E_Strings.T;
      Path_Start :    out E_Strings.T;
      Path_End   :    out E_Strings.T;
      End_Type   :    out Terminal_Point_Type;
      VC_State   :    out VC_State_T;
      DPC_State  :    out DPC_State_T)
   is
   begin
      if Index <= Details.High_Mark and Index /= 0 then
         Success    := True;
         Name       := Details.Details (Index).Name;
         Path_Start := Details.Details (Index).Path_Start;
         Path_End   := Details.Details (Index).Path_End;
         End_Type   := Details.Details (Index).End_Type;
         VC_State   := Details.Details (Index).VC_State;
         DPC_State  := Details.Details (Index).DPC_State;
      else
         Success    := False;
         Name       := E_Strings.Empty_String;
         Path_Start := E_Strings.Empty_String;
         Path_End   := E_Strings.Empty_String;
         End_Type   := Undetermined_Point;
         VC_State   := VC_Not_Present;
         DPC_State  := DPC_Not_Present;
      end if;
   end Retrieve;

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

   function Path_End_To_Path_Type (Line : E_Strings.T) return Terminal_Point_Type is
      Dummy_Position    : E_Strings.Positions;
      End_Position      : E_Strings.Positions;
      Point_Type        : Terminal_Point_Type;
      Refinement_Found  : Boolean;
      Inheritance_Found : Boolean;
      To_Found          : Boolean;
      Check_Found       : Boolean;
      Assert_Found      : Boolean;
      Finish_Found      : Boolean;

      Runtime_Check_Found      : Boolean;
      Precondition_Check_Found : Boolean;
   begin
      --# accept F, 10, Dummy_Position, "Dummy_Position unused here";
      E_Strings.Find_Sub_String
        (E_Str         => Line,
         Search_String => "inheritance",
         String_Found  => Inheritance_Found,
         String_Start  => Dummy_Position);

      E_Strings.Find_Sub_String
        (E_Str         => Line,
         Search_String => "refinement",
         String_Found  => Refinement_Found,
         String_Start  => Dummy_Position);

      --# accept F, 10, To_Found, "To_Found unused here";
      E_Strings.Find_Sub_String (E_Str         => Line,
                                 Search_String => " to ",
                                 String_Found  => To_Found,
                                 String_Start  => End_Position);
      --# end accept;

      E_Strings.Find_Sub_String_After
        (E_Str         => Line,
         Search_Start  => End_Position,
         Search_String => "check",
         String_Found  => Check_Found,
         String_Start  => Dummy_Position);

      if Inheritance_Found then

         Point_Type := Inheritance_VC_Point;

      elsif Refinement_Found then

         Point_Type := Refinement_VC_Point;

      elsif Check_Found then
         E_Strings.Find_Sub_String_After
           (E_Str         => Line,
            Search_Start  => End_Position,
            Search_String => "precondition",
            String_Found  => Precondition_Check_Found,
            String_Start  => Dummy_Position);

         E_Strings.Find_Sub_String_After
           (E_Str         => Line,
            Search_Start  => End_Position,
            Search_String => "run-time",
            String_Found  => Runtime_Check_Found,
            String_Start  => Dummy_Position);

         if Precondition_Check_Found then
            Point_Type := Precondition_Check_Point;
         elsif Runtime_Check_Found then
            Point_Type := Runtime_Check_Point;
         else
            Point_Type := Check_Statement_Point;
         end if;

      else
         E_Strings.Find_Sub_String_After
           (E_Str         => Line,
            Search_Start  => End_Position,
            Search_String => "assert",
            String_Found  => Assert_Found,
            String_Start  => Dummy_Position);

         E_Strings.Find_Sub_String_After
           (E_Str         => Line,
            Search_Start  => End_Position,
            Search_String => "finish",
            String_Found  => Finish_Found,
            String_Start  => Dummy_Position);

         if Assert_Found or Finish_Found then
            Point_Type := Assert_Point;
         else
            Point_Type := Undetermined_Point;
         end if;
      end if;
      --# end accept;

      --# accept F, 33, Dummy_Position, "Dummy_Position unused here" &
      --#        F, 33, To_Found, "To_Found unused here";
      return Point_Type;
   end Path_End_To_Path_Type;

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

   function End_Point_Type (Details : in Data_Type;
                            Index   : in HeapIndex.IndexType) return Terminal_Point_Type is
      Result : Terminal_Point_Type;
   begin
      if Index <= Details.High_Mark and Index /= 0 then

         Result := Details.Details (Index).End_Type;
      else
         Result := Undetermined_Point;
      end if;

      return Result;
   end End_Point_Type;

end VCDetails;
