-------------------------------------------------------------------------------
-- (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.Characters.Latin_1;
with CommandLineHandler;

separate (ErrorHandler.WarningStatus)
procedure ReadWarningFile is
   Option       : E_Strings.T;
   File_OK      : Boolean;
   Warning_File : SPARK_IO.File_Type;

   procedure Open_File
   --# global in     CommandLineData.Content;
   --#        in out SPARK_IO.File_Sys;
   --#           out File_OK;
   --#           out Warning_File;
   --# derives File_OK,
   --#         SPARK_IO.File_Sys,
   --#         Warning_File      from CommandLineData.Content,
   --#                                SPARK_IO.File_Sys;
   is
      File_Name        : E_Strings.T;
      File_Spec_Status : FileSystem.Typ_File_Spec_Status;
      File_Status      : SPARK_IO.File_Status;
   begin
      --# accept Flow, 10, File_Spec_Status, "Expected ineffective assignment to File_Spec_Status";
      FileSystem.Find_Full_File_Name
        (File_Spec      => CommandLineData.Content.Warning_File_Name,
         File_Status    => File_Spec_Status,
         Full_File_Name => File_Name);
      --# end accept;

      Warning_File := SPARK_IO.Null_File; -- to avoid error on opening

      E_Strings.Open
        (File         => Warning_File,
         Mode_Of_File => SPARK_IO.In_File,
         Name_Of_File => File_Name,
         Form_Of_File => "",
         Status       => File_Status);

      if File_Status = SPARK_IO.Ok then
         File_OK := True;
      else
         File_OK := False;
         ScreenEcho.Put_String ("Cannot open file ");
         if CommandLineData.Content.Plain_Output then
            ScreenEcho.Put_ExaminerLine (FileSystem.Just_File (Fn  => File_Name,
                                                               Ext => True));
         else
            ScreenEcho.Put_ExaminerLine (File_Name);
         end if;
      end if;
      --# accept Flow, 33, File_Spec_Status, "Expected File_Spec_Status to be neither referenced nor exported";
   end Open_File;

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

   procedure Close_File
   --# global in     Warning_File;
   --#        in out SPARK_IO.File_Sys;
   --# derives SPARK_IO.File_Sys from *,
   --#                                Warning_File;
   is
      File_Status : SPARK_IO.File_Status;
   begin
      --# accept Flow, 10, File_Status, "Expected ineffective assignment to File_Status" &
      --#        Flow, 10, Warning_File, "Not assigned to. Due to Text_IO mode in out";
      SPARK_IO.Close (Warning_File, File_Status);
      --# end accept;
      --# accept Flow, 33, File_Status, "Expected File_Status to be neither referenced nor exported" &
      --#        Flow, 34, Warning_File, "Not assigned to. Due to Text_IO mode in out";
   end Close_File;

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

   procedure Get_String (File : in     SPARK_IO.File_Type;
                         Str  :    out E_Strings.T)
   --# global in out SPARK_IO.File_Sys;
   --# derives SPARK_IO.File_Sys,
   --#         Str               from File,
   --#                                SPARK_IO.File_Sys;
   is
      Char_OK : Boolean;
      Ch      : Character;

      procedure Get_Char (File : in     SPARK_IO.File_Type;
                          Ch   :    out Character;
                          OK   :    out Boolean)
      --# global in out SPARK_IO.File_Sys;
      --# derives Ch,
      --#         OK,
      --#         SPARK_IO.File_Sys from File,
      --#                                SPARK_IO.File_Sys;
      is
         Ch_Local : Character;
      begin
         if SPARK_IO.End_Of_File (File) then
            OK := False;
            Ch := ' ';
         elsif SPARK_IO.End_Of_Line (File) then
            SPARK_IO.Skip_Line (File, 1);
            OK := True;
            Ch := ' ';
         else
            SPARK_IO.Get_Char (File, Ch_Local);
            if (Ch_Local = Ada.Characters.Latin_1.HT) or (Ch_Local = Ada.Characters.Latin_1.CR) then
               Ch_Local := ' ';
            end if;
            if Ch_Local = '-' then --must be comment start
               SPARK_IO.Skip_Line (File, 1);
               OK := True;
               Ch := ' ';
            else --valid character to return
               OK := True;
               Ch := Ch_Local;
            end if;
         end if;
      end Get_Char;

   begin --Get_String
      Str := E_Strings.Empty_String;

      --skip leading white space
      loop
         Get_Char (File => File,
                   Ch   => Ch,
                   OK   => Char_OK);
         exit when Ch /= ' ';
         exit when not Char_OK;
      end loop;

      if Char_OK then
         loop
            E_Strings.Append_Char (E_Str => Str,
                                   Ch    => Ch);
            Get_Char (File => File,
                      Ch   => Ch,
                      OK   => Char_OK);
            exit when Ch = ' ';
            exit when not Char_OK;
         end loop;
      end if;
   end Get_String;

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

   procedure Invalid_Option (Opt : E_Strings.T)
   --# global in     CommandLineData.Content;
   --#        in     Warning_File;
   --#        in out SPARK_IO.File_Sys;
   --# derives SPARK_IO.File_Sys from *,
   --#                                CommandLineData.Content,
   --#                                Opt,
   --#                                Warning_File;
   is
   begin
      if CommandLineData.Content.Brief then
         if CommandLineData.Content.Plain_Output then
            ScreenEcho.Put_ExaminerString (FileSystem.Just_File (Fn  => CommandLineData.Content.Warning_File_Name,
                                                                 Ext => True));
         else
            ScreenEcho.Put_ExaminerString (CommandLineData.Content.Warning_File_Name);
         end if;

         ScreenEcho.Put_Char (':');
         ScreenEcho.Put_Integer (SPARK_IO.Line (Warning_File), 0, 10);
         ScreenEcho.Put_Char (':');
         ScreenEcho.Put_Integer (1, 0, 10);
         ScreenEcho.Put_Char (':');
         ScreenEcho.Put_String ("Invalid warning option: ");
         ScreenEcho.Put_ExaminerLine (Opt);
      else
         ScreenEcho.Put_String ("Invalid warning option: ");
         ScreenEcho.Put_ExaminerLine (Opt);
      end if;
   end Invalid_Option;

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

   procedure Process_Option (Opt : in E_Strings.T)
   --# global in     CommandLineData.Content;
   --#        in     Warning_File;
   --#        in out LexTokenManager.State;
   --#        in out Pragma_List;
   --#        in out SPARK_IO.File_Sys;
   --#        in out Suppressed_Element;
   --#        in out Suppress_All_Pragmas;
   --# derives LexTokenManager.State,
   --#         Pragma_List           from LexTokenManager.State,
   --#                                    Opt,
   --#                                    Pragma_List,
   --#                                    SPARK_IO.File_Sys,
   --#                                    Warning_File &
   --#         SPARK_IO.File_Sys     from *,
   --#                                    CommandLineData.Content,
   --#                                    Opt,
   --#                                    Pragma_List,
   --#                                    Warning_File &
   --#         Suppressed_Element    from *,
   --#                                    Opt &
   --#         Suppress_All_Pragmas  from *,
   --#                                    Opt,
   --#                                    SPARK_IO.File_Sys,
   --#                                    Warning_File;
   is
      Option_Match : Boolean;

      procedure Process_Pragma
      --# global in     Warning_File;
      --#        in out LexTokenManager.State;
      --#        in out Pragma_List;
      --#        in out SPARK_IO.File_Sys;
      --#        in out Suppress_All_Pragmas;
      --# derives LexTokenManager.State,
      --#         SPARK_IO.File_Sys     from *,
      --#                                    Pragma_List,
      --#                                    SPARK_IO.File_Sys,
      --#                                    Warning_File &
      --#         Pragma_List           from *,
      --#                                    LexTokenManager.State,
      --#                                    SPARK_IO.File_Sys,
      --#                                    Warning_File &
      --#         Suppress_All_Pragmas  from *,
      --#                                    SPARK_IO.File_Sys,
      --#                                    Warning_File;
      is
         Pragma_Name : E_Strings.T;

         procedure Add_Pragma_Name (Prag : in E_Strings.T)
         --# global in out LexTokenManager.State;
         --#        in out Pragma_List;
         --#        in out SPARK_IO.File_Sys;
         --# derives LexTokenManager.State,
         --#         SPARK_IO.File_Sys     from *,
         --#                                    Prag,
         --#                                    Pragma_List &
         --#         Pragma_List           from *,
         --#                                    LexTokenManager.State,
         --#                                    Prag;
         is
            Lex_Name : LexTokenManager.Lex_String;
         begin
            if Pragma_List.Pragma_Count < (ExaminerConstants.MaxPragmasInWarningFile - 1) then
               LexTokenManager.Insert_Examiner_String (Str     => Prag,
                                                       Lex_Str => Lex_Name);
               Pragma_List.Pragma_Count                            := Pragma_List.Pragma_Count + 1;
               Pragma_List.Pragma_Array (Pragma_List.Pragma_Count) := Lex_Name;
            else -- too many
               ScreenEcho.Put_String ("Too many pragmas, ignoring: ");
               ScreenEcho.Put_ExaminerLine (Prag);
            end if;
         end Add_Pragma_Name;

      begin -- Process_Pragma
         Get_String (File => Warning_File,
                     Str  => Pragma_Name);
         if E_Strings.Get_Length (E_Str => Pragma_Name) /= 0 then
            if CommandLineHandler.Check_Option_Name (Opt_Name => Pragma_Name,
                                                     Str      => "all") then
               Suppress_All_Pragmas := True;
            else
               Add_Pragma_Name (Prag => Pragma_Name);
            end if;
         else
            ScreenEcho.Put_Line ("Pragma name missing");
         end if;
      end Process_Pragma;

   begin -- Process_Option
      Option_Match := False;
      case E_Strings.Get_Element (E_Str => Opt,
                                  Pos   => 1) is
         when 'a' | 'A' =>
            case E_Strings.Get_Element (E_Str => Opt,
                                        Pos   => 3) is
               when 'a' | 'A' =>
                  if CommandLineHandler.Check_Option_Name (Opt_Name => Opt,
                                                           Str      => "ada2005_reserved_words") then
                     Suppressed_Element (ErrorHandler.Ada2005_Reserved_Words) := True;
                     Option_Match                                             := True;
                  end if;
               when 'd' | 'D' =>
                  if CommandLineHandler.Check_Option_Name (Opt_Name => Opt,
                                                           Str      => "address_clauses") then
                     Suppressed_Element (ErrorHandler.Unexpected_Address_Clauses) := True;
                     Option_Match                                                 := True;
                  end if;
               when others =>
                  null;
            end case;
         when 'c' | 'C' =>
            if CommandLineHandler.Check_Option_Name (Opt_Name => Opt,
                                                     Str      => "constant_variables") then
               Suppressed_Element (ErrorHandler.Constant_Variables) := True;
               Option_Match                                         := True;
            end if;
         when 'd' | 'D' =>
            case E_Strings.Get_Element (E_Str => Opt,
                                        Pos   => 2) is
               when 'e' | 'E' =>
                  case E_Strings.Get_Element (E_Str => Opt,
                                              Pos   => 3) is
                     when 'c' | 'C' =>
                        if CommandLineHandler.Check_Option_Name (Opt_Name => Opt,
                                                                 Str      => "declare_annotations") then
                           Suppressed_Element (ErrorHandler.Declare_Annotations) := True;
                           Option_Match                                          := True;
                        end if;
                     when 'f' | 'F' =>
                        if CommandLineHandler.Check_Option_Name (Opt_Name => Opt,
                                                                 Str      => "default_loop_assertions") then
                           Suppressed_Element (ErrorHandler.Default_Loop_Assertions) := True;
                           Option_Match                                              := True;
                        end if;
                     when others =>
                        null; -- falls through with Option_Match false and generates error
                  end case;
               when 'i' | 'I' =>
                  if CommandLineHandler.Check_Option_Name (Opt_Name => Opt,
                                                           Str      => "direct_updates") then
                     Suppressed_Element (ErrorHandler.Direct_Updates) := True;
                     Option_Match                                     := True;
                  end if;
               when others =>
                  null;
            end case;
         when 'e' | 'E' =>
            case E_Strings.Get_Element (E_Str => Opt,
                                        Pos   => 3) is
               when 'p' | 'P' =>
                  if CommandLineHandler.Check_Option_Name (Opt_Name => Opt,
                                                           Str      => "expression_reordering") then
                     Suppressed_Element (ErrorHandler.Expression_Reordering) := True;
                     Option_Match                                            := True;
                  end if;
               when 't' | 'T' =>
                  if CommandLineHandler.Check_Option_Name (Opt_Name => Opt,
                                                           Str      => "external_assignment") then
                     Suppressed_Element (ErrorHandler.External_Variable_Assignment) := True;
                     Option_Match                                                   := True;
                  end if;
               when others =>
                  null;
            end case;
         when 'h' | 'H' =>
            case E_Strings.Get_Element (E_Str => Opt,
                                        Pos   => 2) is
               when 'a' | 'A' =>
                  if CommandLineHandler.Check_Option_Name (Opt_Name => Opt,
                                                           Str      => "handler_parts") then
                     Suppressed_Element (ErrorHandler.Handler_Parts) := True;
                     Option_Match                                    := True;
                  end if;
               when 'i' | 'I' =>
                  if CommandLineHandler.Check_Option_Name (Opt_Name => Opt,
                                                           Str      => "hidden_parts") then
                     Suppressed_Element (ErrorHandler.Hidden_Parts) := True;
                     Option_Match                                   := True;
                  end if;
               when others =>
                  null;
            end case;
         when 'i' | 'I' =>
            case E_Strings.Get_Element (E_Str => Opt,
                                        Pos   => 2) is
               when 'm' | 'M' =>
                  if CommandLineHandler.Check_Option_Name (Opt_Name => Opt,
                                                           Str      => "imported_objects") then
                     Suppressed_Element (ErrorHandler.Imported_Objects) := True;
                     Option_Match                                       := True;
                  end if;
               when 'n' | 'N' =>
                  case E_Strings.Get_Element (E_Str => Opt,
                                              Pos   => 3) is
                     when 'd' | 'D' =>
                        if CommandLineHandler.Check_Option_Name (Opt_Name => Opt,
                                                                 Str      => "index_manager_duplicates") then
                           Suppressed_Element (ErrorHandler.Index_Manager_Duplicates) := True;
                           Option_Match                                               := True;
                        end if;
                     when 't' | 'T' =>
                        if CommandLineHandler.Check_Option_Name (Opt_Name => Opt,
                                                                 Str      => "interrupt_handlers") then
                           Suppressed_Element (ErrorHandler.Interrupt_Handlers) := True;
                           Option_Match                                         := True;
                        end if;
                     when others =>
                        null;
                  end case;
               when others =>
                  null;
            end case;
         when 'm' | 'M' =>
            if CommandLineHandler.Check_Option_Name (Opt_Name => Opt,
                                                     Str      => "main_program_precondition") then
               Suppressed_Element (ErrorHandler.Main_Program_Precondition) := True;
               Option_Match                                                := True;
            end if;
         when 'n' | 'N' =>
            if CommandLineHandler.Check_Option_Name (Opt_Name => Opt,
                                                     Str      => "notes") then
               Suppressed_Element (ErrorHandler.Notes) := True;
               Option_Match                            := True;
            end if;
         when 'o' | 'O' =>
            case E_Strings.Get_Element (E_Str => Opt,
                                        Pos   => 2) is
               when 'b' | 'B' =>
                  if CommandLineHandler.Check_Option_Name (Opt_Name => Opt,
                                                           Str      => "obsolescent_features") then
                     Suppressed_Element (ErrorHandler.Obsolescent_Features) := True;
                     Option_Match                                           := True;
                  end if;
               when 't' | 'T' =>
                  if CommandLineHandler.Check_Option_Name (Opt_Name => Opt,
                                                           Str      => "others_clauses") then
                     Suppressed_Element (ErrorHandler.Others_Clauses) := True;
                     Option_Match                                     := True;
                  end if;
               when others =>
                  null;
            end case;
         when 'p' | 'P' =>
            case E_Strings.Get_Element (E_Str => Opt,
                                        Pos   => 3) is
               when 'a' | 'A' =>
                  if CommandLineHandler.Check_Option_Name (Opt_Name => Opt,
                                                           Str      => "pragma") then
                     Suppressed_Element (ErrorHandler.Pragmas) := True;
                     Process_Pragma;
                     Option_Match := True;
                  end if;
               when 'i' | 'I' =>
                  if CommandLineHandler.Check_Option_Name (Opt_Name => Opt,
                                                           Str      => "private_types") then
                     Suppressed_Element (ErrorHandler.Unuseable_Private_Types) := True;
                     Option_Match                                              := True;
                  end if;
               when 'o' | 'O' =>
                  --  We need to check that at least "proof_function_"
                  --  (15 characters) and then one more letter is
                  --  written down, otherwise these all look the same
                  --  and the annoying short-hand features always pick
                  --  the first warning keyword we check for.
                  if E_Strings.Get_Length (Opt) >= 16 then
                     if CommandLineHandler.Check_Option_Name (Opt_Name => Opt,
                                                              Str      => "proof_function_non_boolean") then
                        Suppressed_Element (ErrorHandler.Proof_Function_Non_Boolean) := True;
                        Option_Match                                                 := True;
                     elsif CommandLineHandler.Check_Option_Name (Opt_Name => Opt,
                                                                 Str      => "proof_function_implicit") then
                        Suppressed_Element (ErrorHandler.Proof_Function_Implicit) := True;
                        Option_Match                                              := True;
                     elsif CommandLineHandler.Check_Option_Name (Opt_Name => Opt,
                                                                 Str      => "proof_function_refinement") then
                        Suppressed_Element (ErrorHandler.Proof_Function_Refinement) := True;
                        Option_Match                                                := True;
                     end if;
                  end if;
               when others =>
                  null;
            end case;
         when 'r' | 'R' =>
            case E_Strings.Get_Element (E_Str => Opt,
                                        Pos   => 3) is
               when 'a' | 'A' =>
                  if CommandLineHandler.Check_Option_Name (Opt_Name => Opt,
                                                           Str      => "real_rtcs") then
                     Suppressed_Element (ErrorHandler.Real_RTCs) := True;
                     Option_Match                                := True;
                  end if;
               when 'p' | 'P' =>
                  if CommandLineHandler.Check_Option_Name (Opt_Name => Opt,
                                                           Str      => "representation_clauses") then
                     Suppressed_Element (ErrorHandler.Representation_Clauses) := True;
                     Option_Match                                             := True;
                  end if;
               when others =>
                  null;
            end case;
         when 's' | 'S' =>
            case E_Strings.Get_Element (E_Str => Opt,
                                        Pos   => 2) is
               when 'l' | 'L' =>
                  if CommandLineHandler.Check_Option_Name (Opt_Name => Opt,
                                                           Str      => "sli_generation") then
                     Suppressed_Element (ErrorHandler.SLI_Generation) := True;
                     Option_Match                                     := True;
                  end if;
               when 't' | 'T' =>
                  case E_Strings.Get_Element (E_Str => Opt,
                                              Pos   => 3) is
                     when 'a' | 'A' =>
                        if CommandLineHandler.Check_Option_Name (Opt_Name => Opt,
                                                                 Str      => "static_expressions") then
                           Suppressed_Element (ErrorHandler.Static_Expressions) := True;
                           Option_Match                                         := True;
                        end if;
                     when 'y' | 'Y' =>
                        if CommandLineHandler.Check_Option_Name (Opt_Name => Opt,
                                                                 Str      => "style_check_casing") then
                           Suppressed_Element (ErrorHandler.Style_Check_Casing) := True;
                           Option_Match                                         := True;
                        end if;
                     when others =>
                        null;
                  end case;
               when others =>
                  null;
            end case;
         when 't' | 'T' =>
            if CommandLineHandler.Check_Option_Name (Opt_Name => Opt,
                                                     Str      => "type_conversions") then
               Suppressed_Element (ErrorHandler.Type_Conversions) := True;
               Option_Match                                       := True;
            end if;
         when 'u' | 'U' =>
            case E_Strings.Get_Element (E_Str => Opt,
                                        Pos   => 3) is
               when 'c' | 'C' =>
                  if CommandLineHandler.Check_Option_Name (Opt_Name => Opt,
                                                           Str      => "unchecked_conversion") then
                     Suppressed_Element (ErrorHandler.Unchecked_Conversion) := True;
                     Option_Match                                           := True;
                  end if;
               when 'u' | 'U' =>
                  if CommandLineHandler.Check_Option_Name (Opt_Name => Opt,
                                                           Str      => "unused_variables") then
                     Suppressed_Element (ErrorHandler.Unused_Variables) := True;
                     Option_Match                                       := True;
                  end if;
               when others =>
                  null;
            end case;
         when 'w' | 'W' =>
            if CommandLineHandler.Check_Option_Name (Opt_Name => Opt,
                                                     Str      => "with_clauses") then
               Suppressed_Element (ErrorHandler.With_Clauses) := True;
               Option_Match                                   := True;
            end if;
         when others =>
            null;
      end case;
      if not Option_Match then
         Invalid_Option (Opt => Opt);
      end if;
   end Process_Option;

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

   procedure Sort_Pragmas
   --# global in     LexTokenManager.State;
   --#        in     Suppress_All_Pragmas;
   --#        in out Pragma_List;
   --# derives Pragma_List from *,
   --#                          LexTokenManager.State,
   --#                          Suppress_All_Pragmas;
   is
      J   : Integer;
      Val : LexTokenManager.Lex_String;
   begin
      if not Suppress_All_Pragmas and then Pragma_List.Pragma_Count > 1 then
         for I in reverse Integer range 1 .. Pragma_List.Pragma_Count - 1 loop
            J   := I;
            Val := Pragma_List.Pragma_Array (J);
            while J < Pragma_List.Pragma_Count
              and then LexTokenManager.Lex_String_Case_Insensitive_Compare
              (Lex_Str1 => Pragma_List.Pragma_Array (J + 1),
               Lex_Str2 => Val) =
              LexTokenManager.Str_First loop
               Pragma_List.Pragma_Array (J) := Pragma_List.Pragma_Array (J + 1);
               J                            := J + 1;
            end loop;
            Pragma_List.Pragma_Array (J) := Val;
         end loop;
      end if;
   end Sort_Pragmas;

begin --ReadWarningFile
   if CommandLineData.Content.Warning then
      Open_File;
      if File_OK then
         if CommandLineData.Content.Echo and not CommandLineData.Content.Brief then
            ScreenEcho.New_Line (1);
            ScreenEcho.Put_Line ("           Reading warning control file ...");
         end if;

         loop
            Get_String (File => Warning_File,
                        Str  => Option);
            exit when E_Strings.Get_Length (E_Str => Option) = 0;
            Process_Option (Opt => Option);
         end loop;

         Close_File;

         Sort_Pragmas;

         for I in ErrorHandler.Warning_Elements loop
            Something_Suppressed := Something_Suppressed or Suppressed_Element (I);
         end loop;
      else
         ErrorHandler.File_Open_Error := True;
      end if;
   end if;
end ReadWarningFile;
