-------------------------------------------------------------------------------
-- (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 WarningStatus
--# own SuppressionList is Pragma_List,
--#                        Something_Suppressed,
--#                        Suppressed_Element,
--#                        Suppress_All_Pragmas;
is

   subtype Pragma_Counts is Integer range 0 .. ExaminerConstants.MaxPragmasInWarningFile;
   subtype Pragma_Index is Integer range 1 .. ExaminerConstants.MaxPragmasInWarningFile;

   type Pragma_Arrays is array (Pragma_Index) of LexTokenManager.Lex_String;
   type Pragma_Lists is record
      Pragma_Array : Pragma_Arrays;
      Pragma_Count : Pragma_Counts;
   end record;

   type Suppressed_Element_Array is array (ErrorHandler.Warning_Elements) of Boolean;

   Suppressed_Element   : Suppressed_Element_Array;
   Pragma_List          : Pragma_Lists;
   Something_Suppressed : Boolean;
   Suppress_All_Pragmas : Boolean;

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

   function Pragma_Found (Pragma_Name : LexTokenManager.Lex_String) return Boolean
   --# global in LexTokenManager.State;
   --#        in Pragma_List;
   is
      Look_At, Left, Right : Integer;
      Found                : Boolean;
      Match_Res            : LexTokenManager.Str_Comp_Result;

      function Match_Check (Pos : Integer) return LexTokenManager.Str_Comp_Result
      --# global in LexTokenManager.State;
      --#        in Pragma_List;
      --#        in Pragma_Name;
      is
      begin
         return LexTokenManager.Lex_String_Case_Insensitive_Compare
           (Lex_Str1 => Pragma_List.Pragma_Array (Pos),
            Lex_Str2 => Pragma_Name);
      end Match_Check;

   begin
      Left  := 0;
      Right := Pragma_List.Pragma_Count + 1;
      Found := False;

      loop
         exit when (Left + 1) = Right;
         Look_At := (Left + Right) / 2;

         Match_Res := Match_Check (Look_At);

         if Match_Res = LexTokenManager.Str_Eq then
            Found := True;
            exit;
         end if;

         if Match_Res = LexTokenManager.Str_First then
            Left := Look_At;
         else
            Right := Look_At;
         end if;
      end loop;

      return Found;
   end Pragma_Found;

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

   procedure ReadWarningFile
   --# global in     CommandLineData.Content;
   --#        in out ErrorHandler.File_Open_Error;
   --#        in out LexTokenManager.State;
   --#        in out Pragma_List;
   --#        in out Something_Suppressed;
   --#        in out SPARK_IO.File_Sys;
   --#        in out Suppressed_Element;
   --#        in out Suppress_All_Pragmas;
   --# derives ErrorHandler.File_Open_Error from *,
   --#                                           CommandLineData.Content,
   --#                                           SPARK_IO.File_Sys &
   --#         LexTokenManager.State,
   --#         SPARK_IO.File_Sys,
   --#         Suppressed_Element,
   --#         Suppress_All_Pragmas         from *,
   --#                                           CommandLineData.Content,
   --#                                           LexTokenManager.State,
   --#                                           Pragma_List,
   --#                                           SPARK_IO.File_Sys &
   --#         Pragma_List                  from *,
   --#                                           CommandLineData.Content,
   --#                                           LexTokenManager.State,
   --#                                           SPARK_IO.File_Sys,
   --#                                           Suppress_All_Pragmas &
   --#         Something_Suppressed         from *,
   --#                                           CommandLineData.Content,
   --#                                           LexTokenManager.State,
   --#                                           Pragma_List,
   --#                                           SPARK_IO.File_Sys,
   --#                                           Suppressed_Element;
      is separate;

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

   function Is_Suppressed (The_Element : ErrorHandler.Warning_Elements) return Boolean
   --# global in Suppressed_Element;
   is
   begin
      return Suppressed_Element (The_Element);
   end Is_Suppressed;

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

   function Pragma_Is_Suppressed (Pragma_Name : LexTokenManager.Lex_String) return Boolean
   --# global in LexTokenManager.State;
   --#        in Pragma_List;
   --#        in Suppress_All_Pragmas;
   is
      Result : Boolean;
   begin
      Result := Suppress_All_Pragmas;
      if not Result then
         Result := Pragma_Found (Pragma_Name => Pragma_Name);
      end if;
      return Result;
   end Pragma_Is_Suppressed;

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

   function Get_Description
     (Item : in ErrorHandler.Warning_Elements;
      P1   : in String;
      P2   : in String)
     return E_Strings.T
   is
      Tmp_String, Result : E_Strings.T;
      Posn               : E_Strings.Lengths;
   begin
      -- The messages are parmeterised for different message formats.
      -- The substring %%1 is substituted with the string P1 and
      -- the substring %%2 is substituted with the string P2.
      -- Some message formats require a simple "s£ character to represent a
      -- plural whereas others require the string "(s)".  In one case in one
      -- format has a plural whereas another does not.
      -- This complex scheme is to maintain compatibility with an earlier
      -- message scheme.
      case Item is
         when ErrorHandler.Pragmas =>
            Tmp_String := E_Strings.Copy_String (Str => "Pragma%%1");
         when ErrorHandler.Hidden_Parts =>
            Tmp_String := E_Strings.Copy_String (Str => "Hidden part%%1");
         when ErrorHandler.Handler_Parts =>
            Tmp_String := E_Strings.Copy_String (Str => "Hidden exception handler part%%1");
         when ErrorHandler.Representation_Clauses =>
            Tmp_String := E_Strings.Copy_String (Str => "Representation clause%%1");
         when ErrorHandler.Direct_Updates =>
            Tmp_String := E_Strings.Copy_String (Str => "Direct update%%1 of own variable(s) of non-enclosing package%%1");
         when ErrorHandler.With_Clauses =>
            Tmp_String := E_Strings.Copy_String (Str => "With clause%%1 lacking a supporting inherit");
         when ErrorHandler.Static_Expressions =>
            Tmp_String := E_Strings.Copy_String (Str => "Static expression%%1 too complex for Examiner");
         when ErrorHandler.Style_Check_Casing =>
            Tmp_String := E_Strings.Copy_String (Str => "Style check casing");
         when ErrorHandler.Unused_Variables =>
            Tmp_String := E_Strings.Copy_String (Str => "Variable%%1 declared but not used");
         when ErrorHandler.Constant_Variables =>
            Tmp_String := E_Strings.Copy_String (Str => "Variable%%1 used as constants");
         when ErrorHandler.Type_Conversions =>
            Tmp_String := E_Strings.Copy_String (Str => "Unnecessary type conversion%%1");
         when ErrorHandler.SLI_Generation =>
            Tmp_String := E_Strings.Copy_String (Str => "Stop SLI generation");
         when ErrorHandler.Index_Manager_Duplicates =>
            Tmp_String := E_Strings.Copy_String (Str => "Duplicate entry in index files");
         when ErrorHandler.Others_Clauses =>
            Tmp_String := E_Strings.Copy_String (Str => "Unnecessary others clause%%1");
         when ErrorHandler.Imported_Objects =>
            Tmp_String := E_Strings.Copy_String (Str => "Use%%1 of pragma Import on objects");
         when ErrorHandler.Unexpected_Address_Clauses =>
            Tmp_String := E_Strings.Copy_String (Str => "Unexpected address clause%%1");
         when ErrorHandler.Main_Program_Precondition =>
            Tmp_String := E_Strings.Copy_String (Str => "Precondition on main program");
         when ErrorHandler.Proof_Function_Non_Boolean =>
            Tmp_String := E_Strings.Copy_String (Str => "Non-boolean proof functions");
         when ErrorHandler.Proof_Function_Implicit =>
            Tmp_String := E_Strings.Copy_String (Str => "Proof functions with implicit return");
         when ErrorHandler.Proof_Function_Refinement =>
            Tmp_String := E_Strings.Copy_String (Str => "Refined proof functions");
         when ErrorHandler.Expression_Reordering =>
            Tmp_String := E_Strings.Copy_String (Str => "Reordering of expressions");
         when ErrorHandler.Notes =>
            Tmp_String := E_Strings.Copy_String (Str => "Note%%1");
         when ErrorHandler.Unuseable_Private_Types =>
            Tmp_String := E_Strings.Copy_String (Str => "Private type%%1 lacking method of initialization");
         when ErrorHandler.External_Variable_Assignment =>
            Tmp_String := E_Strings.Copy_String (Str => "Assignment%%2 or return%%2 of external variables");
         when ErrorHandler.Declare_Annotations =>
            Tmp_String := E_Strings.Copy_String (Str => "Declare annotations in non Ravenscar programs");
         when ErrorHandler.Interrupt_Handlers =>
            Tmp_String := E_Strings.Copy_String (Str => "Protected objects that include interrupt handlers");
         when ErrorHandler.Unchecked_Conversion =>
            Tmp_String := E_Strings.Copy_String (Str => "Use%%1 of instantiations of Unchecked_Conversion");
         when ErrorHandler.Ada2005_Reserved_Words =>
            Tmp_String := E_Strings.Copy_String (Str => "Use%%1 of Ada2005 reserved words");
         when ErrorHandler.Obsolescent_Features =>
            Tmp_String := E_Strings.Copy_String (Str => "Use%%1 of obsolete feature from Ada83 in SPARK 95 mode");
         when ErrorHandler.Default_Loop_Assertions =>
            Tmp_String := E_Strings.Copy_String (Str => "Generation of default loop assertions");
         when ErrorHandler.Real_RTCs =>
            Tmp_String := E_Strings.Copy_String (Str => "Generation of RTCs on real numbers");
      end case;

      Posn   := 0;
      Result := E_Strings.Empty_String;
      while Posn < E_Strings.Get_Length (E_Str => Tmp_String) loop
         Posn := Posn + 1;
         if Posn + 2 <= E_Strings.Get_Length (E_Str => Tmp_String)
           and then E_Strings.Get_Element (E_Str => Tmp_String,
                                           Pos   => Posn) = '%'
           and then E_Strings.Get_Element (E_Str => Tmp_String,
                                           Pos   => Posn + 1) = '%'
           and then (E_Strings.Get_Element (E_Str => Tmp_String,
                                            Pos   => Posn + 2) = '1'
                       or else E_Strings.Get_Element (E_Str => Tmp_String,
                                                      Pos   => Posn + 2) = '2') then
            if E_Strings.Get_Element (E_Str => Tmp_String,
                                      Pos   => Posn + 2) = '1' then
               E_Strings.Append_String (E_Str => Result,
                                        Str   => P1);
            else
               E_Strings.Append_String (E_Str => Result,
                                        Str   => P2);
            end if;
            Posn := Posn + 2;
         else
            E_Strings.Append_Char (E_Str => Result,
                                   Ch    => E_Strings.Get_Element (E_Str => Tmp_String,
                                                                   Pos   => Posn));
         end if;
      end loop;
      return Result;
   end Get_Description;

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

   procedure Output_Warning_List (To_File : in SPARK_IO.File_Type)
   --# global in     CommandLineData.Content;
   --#        in     LexTokenManager.State;
   --#        in     Pragma_List;
   --#        in     Something_Suppressed;
   --#        in     Suppressed_Element;
   --#        in     Suppress_All_Pragmas;
   --#        in out SPARK_IO.File_Sys;
   --#        in out XMLReport.State;
   --# derives SPARK_IO.File_Sys from *,
   --#                                CommandLineData.Content,
   --#                                LexTokenManager.State,
   --#                                Pragma_List,
   --#                                Something_Suppressed,
   --#                                Suppressed_Element,
   --#                                Suppress_All_Pragmas,
   --#                                To_File,
   --#                                XMLReport.State &
   --#         XMLReport.State   from *,
   --#                                CommandLineData.Content,
   --#                                Pragma_List,
   --#                                Something_Suppressed,
   --#                                Suppressed_Element,
   --#                                Suppress_All_Pragmas;
   is

      Description : E_Strings.T;

      procedure Put_Pragmas
      --# global in     CommandLineData.Content;
      --#        in     LexTokenManager.State;
      --#        in     Pragma_List;
      --#        in     Suppressed_Element;
      --#        in     Suppress_All_Pragmas;
      --#        in     To_File;
      --#        in out SPARK_IO.File_Sys;
      --#        in out XMLReport.State;
      --# derives SPARK_IO.File_Sys from *,
      --#                                CommandLineData.Content,
      --#                                LexTokenManager.State,
      --#                                Pragma_List,
      --#                                Suppressed_Element,
      --#                                Suppress_All_Pragmas,
      --#                                To_File,
      --#                                XMLReport.State &
      --#         XMLReport.State   from *,
      --#                                CommandLineData.Content,
      --#                                Pragma_List,
      --#                                Suppressed_Element,
      --#                                Suppress_All_Pragmas;
      is
         Wrap       : constant Integer := 72;
         Margin     : constant Integer := 14;
         Column     : Integer;
         Punct      : Character;
         Pragma_Str : E_Strings.T;

         procedure Put_Pragma_Name (Str : LexTokenManager.Lex_String)
         --# global in     LexTokenManager.State;
         --#        in     To_File;
         --#        in out Column;
         --#        in out Punct;
         --#        in out SPARK_IO.File_Sys;
         --# derives Column            from *,
         --#                                LexTokenManager.State,
         --#                                Str &
         --#         Punct             from  &
         --#         SPARK_IO.File_Sys from *,
         --#                                Column,
         --#                                LexTokenManager.State,
         --#                                Punct,
         --#                                Str,
         --#                                To_File;
         is
            Result : E_Strings.T;
         begin
            Result := LexTokenManager.Lex_String_To_String (Lex_Str => Str);
            SPARK_IO.Put_Char (To_File, Punct);
            SPARK_IO.Put_Char (To_File, ' ');
            Punct  := ',';
            Column := Column + 2;
            if Column + E_Strings.Get_Length (E_Str => Result) > Wrap then
               SPARK_IO.New_Line (To_File, 1);
               SPARK_IO.Put_String (To_File, "            ", 0);
               Column := Margin;
            end if;
            E_Strings.Put_String (File  => To_File,
                                  E_Str => Result);
            Column := Column + E_Strings.Get_Length (E_Str => Result);
         end Put_Pragma_Name;

         function Get_Pragma_Name (Str : LexTokenManager.Lex_String) return E_Strings.T
         --# global in LexTokenManager.State;
         is
         begin
            return LexTokenManager.Lex_String_To_String (Lex_Str => Str);
         end Get_Pragma_Name;

      begin --Put_Pragmas
         if CommandLineData.Content.XML then
            if Suppress_All_Pragmas then
               Pragma_Str := E_Strings.Copy_String (Str => "all");
               XMLReport.Suppressed_Pragma (Item => Pragma_Str);
               E_Strings.Put_String (File  => To_File,
                                     E_Str => Pragma_Str);
            elsif Suppressed_Element (ErrorHandler.Pragmas) then
               for I in Integer range 1 .. Pragma_List.Pragma_Count loop
                  Pragma_Str := Get_Pragma_Name (Str => Pragma_List.Pragma_Array (I));
                  XMLReport.Suppressed_Pragma (Item => Pragma_Str);
                  E_Strings.Put_String (File  => To_File,
                                        E_Str => Pragma_Str);
               end loop;
            end if;
         else
            if Suppress_All_Pragmas then
               SPARK_IO.Put_Line (To_File, "   All pragmas", 0);
            elsif Suppressed_Element (ErrorHandler.Pragmas) then
               Column := Margin;
               Punct  := ':';
               SPARK_IO.Put_String (File => To_File,
                                    Item => "   ",
                                    Stop => 0);
               E_Strings.Put_String (File  => To_File,
                                     E_Str => Get_Description (Item => ErrorHandler.Pragmas,
                                                               P1   => "s",
                                                               P2   => ""));
               for I in Integer range 1 .. Pragma_List.Pragma_Count loop
                  Put_Pragma_Name (Str => Pragma_List.Pragma_Array (I));
               end loop;
            end if;
            SPARK_IO.New_Line (To_File, 1);
         end if;
      end Put_Pragmas;

   begin  --Output_Warning_List
      if CommandLineData.Content.XML then
         XMLReport.Start_Section (Section => XMLReport.S_Warnings_Config,
                                  Report  => To_File);
         if Something_Suppressed then
            for I in ErrorHandler.Warning_Elements range ErrorHandler.Hidden_Parts .. ErrorHandler.Warning_Elements'Last loop
               if Suppressed_Element (I) then
                  Description := Get_Description (Item => I,
                                                  P1   => "s",
                                                  P2   => "");
                  XMLReport.Suppressed (Item => Description);
                  E_Strings.Put_String (File  => To_File,
                                        E_Str => Description);
               end if;
            end loop;
            Put_Pragmas;
         end if;
         XMLReport.End_Section (Section => XMLReport.S_Warnings_Config,
                                Report  => To_File);
      else
         SPARK_IO.New_Line (To_File, 2);
         if Something_Suppressed then
            SPARK_IO.Put_Line (To_File, "Summary warning reporting selected for:", 0);
            for I in ErrorHandler.Warning_Elements range ErrorHandler.Hidden_Parts .. ErrorHandler.Warning_Elements'Last loop
               if Suppressed_Element (I) then
                  SPARK_IO.Put_String (File => To_File,
                                       Item => "   ",
                                       Stop => 0);
                  E_Strings.Put_Line (File  => To_File,
                                      E_Str => Get_Description (Item => I,
                                                                P1   => "s",
                                                                P2   => ""));
               end if;
            end loop;
            Put_Pragmas;
         else
            SPARK_IO.Put_Line (To_File, "Full warning reporting selected", 0);
         end if;

      end if;

   end Output_Warning_List;

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

   procedure Report_Suppressed_Warnings (To_File : in SPARK_IO.File_Type;
                                         Counter : in ErrorHandler.Counters)
   --# global in     Something_Suppressed;
   --#        in     Suppressed_Element;
   --#        in out SPARK_IO.File_Sys;
   --# derives SPARK_IO.File_Sys from *,
   --#                                Counter,
   --#                                Something_Suppressed,
   --#                                Suppressed_Element,
   --#                                To_File;
   is
      Indent         : constant Integer := 6;
      Total_Warnings : Integer;
      Severe_Warning : Boolean          := False;
      Tmp_String     : E_Strings.T;

      procedure Put_Count (Count : in Integer;
                           Width : in Integer)
      --# global in     To_File;
      --#        in out SPARK_IO.File_Sys;
      --# derives SPARK_IO.File_Sys from *,
      --#                                Count,
      --#                                To_File,
      --#                                Width;
      is
      begin
         SPARK_IO.Put_Integer (To_File, Count, Width, 10);
      end Put_Count;

   begin  --Report_Suppressed_Warnings
      if Something_Suppressed then

         Total_Warnings := 0;
         for I in ErrorHandler.Warning_Elements loop
            Total_Warnings := Total_Warnings + Integer (Counter (I));
         end loop;

         if Total_Warnings = 0 then
            SPARK_IO.Put_Line (To_File, "No summarized warnings", 0);
            SPARK_IO.New_Line (To_File, 1);
         else
            Put_Count (Count => Total_Warnings,
                       Width => 0);
            SPARK_IO.Put_Line (To_File, " summarized warning(s), comprising:", 0);
            for I in ErrorHandler.Warning_Elements loop
               if Suppressed_Element (I) and then Counter (I) > 0 then
                  Put_Count (Count => Integer (Counter (I)),
                             Width => Indent);
                  SPARK_IO.Put_Char (File => To_File,
                                     Item => ' ');
                  Tmp_String := Get_Description (Item => I,
                                                 P1   => "(s)",
                                                 P2   => "(s)");
                  if E_Strings.Get_Length (E_Str => Tmp_String) > 0 then
                     Tmp_String := E_Strings.Lower_Case_Char (E_Str => Tmp_String,
                                                              Pos   => 1);
                  end if;

                  E_Strings.Put_String (File  => To_File,
                                        E_Str => Tmp_String);

                  if I in ErrorHandler.Severe_Warnings then
                     SPARK_IO.Put_Char (To_File, '*');
                     Severe_Warning := True;
                  end if;
                  SPARK_IO.New_Line (To_File, 1);
               end if;
            end loop;
            if Severe_Warning then
               SPARK_IO.Put_Line (To_File, "(*Note: the above warnings may affect the validity of the analysis.)", 0);
            end if;
            SPARK_IO.New_Line (To_File, 1);
         end if;
      end if;
   end Report_Suppressed_Warnings;

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

begin
   Suppressed_Element       := Suppressed_Element_Array'(others => False);
   Pragma_List.Pragma_Count := 0; --will cause flow error
   Suppress_All_Pragmas     := False;
   Something_Suppressed     := False;
   --# accept Flow, 32, Pragma_List.Pragma_Array, "Init. is partial but effective." &
   --#        Flow, 31, Pragma_List.Pragma_Array, "Init. is partial but effective." &
   --#        Flow, 602, Pragma_List, Pragma_List.Pragma_Array, "Init. is partial but effective.";
end WarningStatus;
