------------------------------------------------------------------------------
--                                                                          --
--                          GNATCHECK COMPONENTS                            --
--                                                                          --
--                  G N A T C H E C K . D I A G N O S E S                   --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                     Copyright (C) 2005-2007, AdaCore                     --
--                                                                          --
-- GNATCHECK  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 2, or ( at your option)  any  later --
-- version.  GNATCHECK  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 GNAT; see file  COPYING. If --
-- not,  write to the  Free Software Foundation,  51 Franklin Street, Fifth --
-- Floor, Boston, MA 02110-1301, USA.                                       --
--                                                                          --
-- GNATCHECK is maintained by AdaCore (http://www.adacore.com).             --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Calendar;            use Ada.Calendar;
with Ada.Characters.Handling; use Ada.Characters.Handling;
with Ada.Strings;             use Ada.Strings;
with Ada.Strings.Fixed;       use Ada.Strings.Fixed;
with Ada.Text_IO;             use Ada.Text_IO;

with GNAT.OS_Lib;             use GNAT.OS_Lib;

with Asis.Implementation;

with Atree;                   use Atree;
with Sinput;                  use Sinput;
with Table;
with Types;

with Asis.Set_Get;            use Asis.Set_Get;

with ASIS_UL.Common;          use ASIS_UL.Common;
with ASIS_UL.Misc;            use ASIS_UL.Misc;
with ASIS_UL.Options;         use ASIS_UL.Options;
with ASIS_UL.Output;          use ASIS_UL.Output;

with Gnatcheck.Options;       use Gnatcheck.Options;
with Gnatcheck.Output;        use Gnatcheck.Output;
with Gnatcheck.Rules.Output;  use Gnatcheck.Rules.Output;

package body Gnatcheck.Diagnoses is

   All_Section_On : Boolean := True;
   --  This flag is set of by the first '-s{1|2|3} option together with setting
   --  OFF all the flags responsible for outputting a specific report file
   --  option

   ---------------------
   -- Diagnoses Table --
   ---------------------

   type Diag_Id is new Natural;
   No_Diag    : constant Diag_Id := Diag_Id'First;
   First_Diag : constant Diag_Id := No_Diag + 1;

   function No      (D : Diag_Id) return Boolean;
   function Present (D : Diag_Id) return Boolean;
   --  Check whether or not the argument is the Id of some existing diagnosis

   type Diagnosis_Record is record
      Rule          : Rule_Id;
      SF            : SF_Id;
      Diagnosis_Num : Diagnosis_Variant;

      Line          : Types.Physical_Line_Number;
      Col           : Types.Column_Number;
      --  We use GNAT types for line and column numbers

      Next_Diag           : Diag_Id;
      Prev_Diag           : Diag_Id;
      Next_Same_Rule_Diag : Diag_Id;
      Prev_Same_Rule_Diag : Diag_Id;
      --  For each source file, diagnostic messages are chained twice. First,
      --  we have the chain of all the rule violations detected for the current
      --  source, ordered by increasing the Sloc of the violation, and second,
      --  for each rule we have a chain of the violations of this particular
      --  rule, also ordered by increasing the Slocs

      Diag_Text : String_Loc;
      --  For the "rules" corresponding to the checks performed by the compiler
      --  (that is, general warnings, style warnings and restriction warnings)
      --  we do not have any diagnosis stored as a part of the corresponding
      --  rule, so we have to store the diagnostic messages as it is extracted
      --  from the compiler-generated information. This field is used to store
      --  such a diagnostic message

      SLOC : String_Loc;
      --  We use the Line and Col fields to order diagnoses, and we use the
      --  SLOC field to put the full GNAT location in the report

   end record;

   package Rule_Violations is new Table.Table (
     Table_Component_Type => Diagnosis_Record,
     Table_Index_Type     => Diag_Id,
     Table_Low_Bound      => First_Diag,
     Table_Initial        => 10000,
     Table_Increment      => 100,
     Table_Name           => "diagnoses database");

   Diag_Table : Rule_Violations.Table_Ptr renames Rule_Violations.Table;

   ----------------------------------------
   --  File-Rule-Diagnosis Mapping Table --
   ----------------------------------------

   --  This table for each rule and for each source contains the links to the
   --  first and to the last detected diagnosis corresponding to the violation
   --  of the given rule in the given source. It also contains as its last row
   --  links to the first and to the latest detected violation of (any) rule
   --  detected in the given source.

   type Detected_Violations is record
      First : Diag_Id;
      Last  : Diag_Id;
   end record;
   --  An elementary entry in the Mapping Table. Contains the links to the
   --  first and to the last diagnosis for the given rule in the given file.

   No_Violation : constant Detected_Violations := (No_Diag, No_Diag);

   type File_Mapping_Type is array (Rule_Id range <>) of Detected_Violations;
   --  The diagnosis mapping for a single file

   type File_Mapping_Type_Access is access File_Mapping_Type;
   --  We do not know how many rules we will have, so we have to use dynamic
   --  mappings

   package Mapping_Table_Package is  new Table.Table (
     Table_Component_Type => File_Mapping_Type_Access,
     Table_Index_Type     => SF_Id,
     Table_Low_Bound      => First_SF_Id,
     Table_Initial        => 10000,
     Table_Increment      => 100,
     Table_Name           => "diagnoses mapping database");
   --  The Mapping Table. We have to use dynamic table here, because we do not
   --  know in advance how many needed sources may be added during the rule
   --  checking

   Mapping_Table : Mapping_Table_Package.Table_Ptr renames
     Mapping_Table_Package.Table;

   All_Diags : Rule_Id;
   --  The index of the last row in the table that contains the beginning and
   --  the end of all the diagnosis for the given file;

   Warning_Diags     : Rule_Id;
   Style_Diags       : Rule_Id;
   Restriction_Diags : Rule_Id;
   --  Rows to store compiler warnings, they immediately precede All_Diags

   function First_Diagnosis      (SF : SF_Id)              return Diag_Id;
   function First_Rule_Diagnosis (SF : SF_Id; R : Rule_Id) return Diag_Id;
   function Last_Diagnosis       (SF : SF_Id)              return Diag_Id;
   function Last_Rule_Diagnosis  (SF : SF_Id; R : Rule_Id) return Diag_Id;
   --  Returns the first (last) diagnostic stored for the given source (and for
   --  the given rule)

   procedure Set_First_Diagnosis      (SF : SF_Id; D : Diag_Id);
   procedure Set_First_Rule_Diagnosis (SF : SF_Id; R : Rule_Id; D : Diag_Id);
   procedure Set_Last_Diagnosis       (SF : SF_Id; D : Diag_Id);
   procedure Set_Last_Rule_Diagnosis  (SF : SF_Id; R : Rule_Id; D : Diag_Id);
   --  Sets the first (last) diagnostic stored for the given source (and for
   --  the given rule)

   procedure Store_Rule_Violation_Internal
     (For_Rule      : Rule_Id;
      Line_Num      : Types.Physical_Line_Number;
      Col_Num       : Types.Column_Number;
      In_SF         : SF_Id;
      Diagnosis_Num : Diagnosis_Variant := 0;
      Diag_Text     : String_Loc        := Nil_String_Loc;
      Element_SLOC  : String_Loc        := Nil_String_Loc);
   --  This routine does the actual job for storing the diagnosis into
   --  diagnosis table. It needs to know only the rule, the file, the line and
   --  column to associate the diagnosis with and the diagnostic variant.

   -----------------------
   -- Local subprograms --
   -----------------------

   --  The following subprograms are used to generate GNATCHECK report.
   --  (Should all of these routines be defined here?)

   procedure Print_Report_Header;
   --  Generates the report header, including the date.

   procedure Print_Active_Rules;
   --  Generate the list of rules used (set as active) for the given gnatcheck
   --  run.

   procedure Print_Disabled_Rules;
   --  Generate the list of rules currently defined in gnatcheck, but not used
   --  (set as disabled) for the given gnatcheck run.

   procedure Print_Source_List;
   --  Prints list of sources set as the arguments for the given gnatcheck run.

   procedure Print_Failure_Info;
   --  Prints info about non-fatal failures detected during gnatcheck run.

   procedure Print_Sections_Summary;
   --  Gives a short summary of the sections contained in the report.

   procedure Print_Section_1;
   --  Print out the list of rule violations in compiler-like style (grouped
   --  by files with no specific order, and for each file diagnosis are
   --  ordered by the source locations of the wrong constructs)

   procedure Print_Section_2;
   --  Prints out the list of violations ordered by rules. For each rule
   --  violations detected in the same file are grouped together and are
   --  ordered  by the source locations of the wrong constructs.

   procedure Print_Section_3;
   --  Prints the list of violations where diagnoses are first ordered by
   --  rules, and for each file - by rules.

   procedure Compute_Alignment
     (For_File :     SF_Id;
      Line_Pos : out Natural;
      Col_Pos  : out Natural);
   --  For the diagnostic messages generated for  For_File computes the max
   --  number of positions for line and column number (the caller is
   --  responsible for the fact that diagnosis chain for For_File is not empty)

   function Line_Col
     (D        : Diag_Id;
      Line_Pos : Natural := 0;
      Col_Pos  : Natural := 0)
      return     String;
   --  For the given diagnosis, returns the location in the form
   --  "line_number:coulumn_number". If Line_Pos and Col_Pos are not equal to
   --  zero, uses exactly Line_Pos positions for line_number and exactly
   --  Col_Pos positions for coulumn_number, raises Constraint_Error if the
   --  room is unsufficient

   function Line (D : Diag_Id) return Types.Physical_Line_Number;
   function Col (D : Diag_Id)  return Types.Column_Number;
   --  For the given diagnosis, return the line and column numbers

   function Text_Diag (D : Diag_Id) return String;
   --  Returns the text of the corresponding diagnosis message. This includes
   --  resolving the diagnosis variants, if needed

   -------------------------------
   -- Add_Line_To_Mapping_Table --
   -------------------------------

   procedure Add_Line_To_Mapping_Table is
   begin
      Mapping_Table_Package.Append
        (new File_Mapping_Type'(All_Rules.First .. All_Diags =>
                                No_Violation));
   end Add_Line_To_Mapping_Table;

   ---------
   -- Col --
   ---------

   function Col (D : Diag_Id)  return Types.Column_Number is
   begin
      return Diag_Table (D).Col;
   end Col;

   ------------------------
   --  Compute_Alignment --
   ------------------------

   procedure Compute_Alignment
     (For_File : SF_Id;
      Line_Pos : out Natural;
      Col_Pos  : out Natural)
   is
      Max_Pos     : Natural;
      Max_Col_Num : Types.Column_Number := 1;
      Next_Diag   : Diag_Id;
   begin
      --  Max line positions
      Max_Pos  := Positive (Line (Last_Diagnosis (For_File)));
      Line_Pos := 0;

      while Max_Pos > 0 loop
         Line_Pos := Line_Pos + 1;
         Max_Pos  := Max_Pos / 10;
      end loop;

      --  Max column positions

      Next_Diag := First_Diagnosis (For_File);

      while Present (Next_Diag) loop

         if Types.">" (Col (Next_Diag), Max_Col_Num) then
            Max_Col_Num :=  Col (Next_Diag);
         end if;

         Next_Diag := Diag_Table (Next_Diag).Next_Diag;
      end loop;

      Max_Pos := Positive (Max_Col_Num);
      Col_Pos := 0;

      while Max_Pos > 0 loop
         Col_Pos := Col_Pos + 1;
         Max_Pos := Max_Pos / 10;
      end loop;

   end Compute_Alignment;

   --------------------------
   -- Create_Mapping_Table --
   --------------------------

   procedure Create_Mapping_Table is
      Rule_Number : constant Rule_Id := All_Rules.Last + 1 + 3;
      --  "+1" - for the total number of violations
      --  "+3" - for general warnings, style warnings and restriction warnings
   begin
      Mapping_Table_Package.Set_Last (Last_Argument_Source);

      for J in First_SF_Id .. Last_Argument_Source loop
         Mapping_Table (J) :=
           new File_Mapping_Type'(All_Rules.First .. Rule_Number =>
               No_Violation);
      end loop;

      All_Diags := Rule_Number;

      Warning_Diags     := All_Diags - 3;
      Style_Diags       := All_Diags - 2;
      Restriction_Diags := All_Diags - 1;

   end Create_Mapping_Table;

   --------------------------------
   -- Diag_Structure_Debug_Image --
   --------------------------------

   procedure Diag_Structure_Debug_Image is
      Ident_String : constant String := "   ";
      procedure Print_Diag_Node (N : Diag_Id);
      --  Prints out one diag node

      procedure Pring_File_Mapping (SF : SF_Id);
      --  Prints out mapping for the argument file

      procedure Print_Diag_Node (N : Diag_Id) is
      begin
         Put_Line ("Diag_Id =" & N'Img);
         Put (Ident_String);
         Put_Line ("Rule = " & All_Rules.Table (Diag_Table (N).Rule).Name.all);

         Put (Ident_String);
         Put_Line ("SF =  " & Diag_Table (N).SF'Img);

         Put (Ident_String);
         Put_Line ("Line =" & Diag_Table (N).Line'Img &
                  " Col=" & Diag_Table (N).Col'Img);

         Put (Ident_String);
         Put_Line ("Next_Diag =           " & Diag_Table (N).Next_Diag'Img);

         Put (Ident_String);
         Put_Line ("Prev_Diag =           " & Diag_Table (N).Prev_Diag'Img);

         Put (Ident_String);
         Put_Line ("Next_Same_Rule_Diag = " &
                   Diag_Table (N).Next_Same_Rule_Diag'Img);

         Put (Ident_String);
         Put_Line ("Prev_Same_Rule_Diag = " &
                   Diag_Table (N).Prev_Same_Rule_Diag'Img);

      end Print_Diag_Node;

      procedure Pring_File_Mapping (SF : SF_Id) is
         procedure Print_Rule_Mapping (R : Rule_Id; SF : SF_Id);
         --  Prints out the concrete diagnosis mapping

         procedure Print_Rule_Mapping (R : Rule_Id; SF : SF_Id) is
         begin

            Put (Ident_String);

            if R <= All_Rules.Last then
               Put_Line ("Rule = " &
                         All_Rules.Table (R).Name.all);
            else
               Put_Line ("All Rules");
            end if;

            Put (Ident_String);
            Put (Ident_String);
            Put_Line ("First =" & Mapping_Table (SF) (R) .First'Img &
                      " Last =" & Mapping_Table (SF) (R).Last'Img);

         end Print_Rule_Mapping;
      begin
         Put_Line ("Mapping for file " & SF'Img);

         for J in Mapping_Table (SF)'Range loop
            Print_Rule_Mapping (J, SF);
         end loop;

      end Pring_File_Mapping;

   begin
      Put_Line ("**** Diag_Table start *****");

      for J in First_Diag .. Rule_Violations.Last loop
         Print_Diag_Node (J);
      end loop;

      Put_Line ("**** Diag_Table end *****");

      Put_Line ("**** Mappint_Table start *****");

      for J in First_SF_Id .. Mapping_Table_Package.Last loop
         Pring_File_Mapping (J);
      end loop;

      Put_Line ("**** Mapping_Table end *****");

   end Diag_Structure_Debug_Image;

   ---------------------
   -- First_Diagnosis --
   ---------------------

   function First_Diagnosis (SF : SF_Id) return Diag_Id is
   begin
      return Mapping_Table (SF) (All_Diags).First;
   end First_Diagnosis;

   --------------------------
   -- First_Rule_Diagnosis --
   --------------------------

   function First_Rule_Diagnosis (SF : SF_Id; R : Rule_Id) return Diag_Id is
   begin
      return Mapping_Table (SF) (R).First;
   end First_Rule_Diagnosis;

   ---------------------
   -- Generate_Report --
   ---------------------

   procedure Generate_Report is
   begin
      Set_Report_File;

      if not Short_Report then
         Print_Report_Header;
         Print_Active_Rules;
         Print_Disabled_Rules;
         Print_Source_List;
         Print_Failure_Info;
         Print_Sections_Summary;
      end if;

      if Output_Section_1
        or else
         not Quiet_Mode
      then
         Print_Section_1;
      end if;

      if Output_Section_2 then
         Print_Section_2;
      end if;

      if Output_Section_3 then
         Print_Section_3;
      end if;

      Close_Report_File;
   end Generate_Report;

   --------------------
   -- Last_Diagnosis --
   --------------------

   function Last_Diagnosis (SF : SF_Id) return Diag_Id is
   begin
      return Mapping_Table (SF) (All_Diags).Last;
   end Last_Diagnosis;

   -------------------------
   -- Last_Rule_Diagnosis --
   -------------------------

   function Last_Rule_Diagnosis (SF : SF_Id; R : Rule_Id) return Diag_Id is
   begin
      return Mapping_Table (SF) (R).Last;
   end Last_Rule_Diagnosis;

   --------------
   -- Line_Col --
   --------------

   function Line_Col
     (D        : Diag_Id;
      Line_Pos : Natural := 0;
      Col_Pos  : Natural := 0)
      return     String
   is
      Line_Str : constant String := Trim (Diag_Table (D).Line'Img, Left);
      Col_Str  : constant String := Trim (Diag_Table (D).Col'Img, Left);
   begin
      return
        (1 .. Line_Pos - Line_Str'Length => ' ') &
        Line_Str                                 &
        ':'                                      &
        (1 .. Col_Pos - Col_Str'Length => ' ')   &
        Col_Str;
   end Line_Col;

   ----------
   -- Line --
   ----------

   function Line (D : Diag_Id) return Types.Physical_Line_Number is
   begin
      return Diag_Table (D).Line;
   end Line;

   --------
   -- No --
   --------

   function No (D : Diag_Id) return Boolean is
   begin
      return D not in First_Diag .. Rule_Violations.Last;
   end No;

   -------------
   -- Present --
   -------------

   function Present (D : Diag_Id) return Boolean is
   begin
      return D in First_Diag .. Rule_Violations.Last;
   end Present;

   ------------------------
   -- Print_Active_Rules --
   ------------------------

   procedure Print_Active_Rules is
   begin
      Report ("Applied rules:");

      for Rule in All_Rules.First .. All_Rules.Last loop

         if All_Rules.Table (Rule).Rule_State /= Disabled then
            Report_No_EOL ("(" & All_Rules.Table (Rule).Name.all & ") ", 1);
            Report (All_Rules.Table (Rule).Help_Info.all);
         end if;
      end loop;

      Report_EOL;

      --  Compiler-made checks:

      if Use_gnaty_Option then
         Report_No_EOL ("Compiler style checks: (", 1);
         Report (Get_Style_Option & ")");
      end if;

      if Use_gnatw_Option then
         Report_No_EOL ("Compiler warnings: (", 1);
         Report (Get_Warning_Option & ")");
      end if;

      if Check_Restrictions then
         Report ("Compiler-checked restrictions:", 1);
         Print_Active_Restrictions (2);
      end if;

   end Print_Active_Rules;

   --------------------------
   -- Print_Disabled_Rules --
   --------------------------

   procedure Print_Disabled_Rules is
   begin
      Report ("Disabled rules:");

      for Rule in All_Rules.First .. All_Rules.Last loop

         if All_Rules.Table (Rule).Rule_State = Disabled then
            Report_No_EOL ("(" & All_Rules.Table (Rule).Name.all & ") ", 1);
            Report (All_Rules.Table (Rule).Help_Info.all);
         end if;
      end loop;

      Report_EOL;

      --  Compiler-made checks:

      if not Use_gnaty_Option then
         Report ("No active compiler style check", 1);
      end if;

      if not Use_gnatw_Option then
         Report ("No active compiler warning:", 1);
      end if;

      if not Check_Restrictions then
         Report ("No active compiler-checked restriction", 1);
      end if;

      Report_EOL;

   end Print_Disabled_Rules;

   ------------------------
   -- Print_Failure_Info --
   ------------------------

   procedure Print_Failure_Info is
   begin

      if Tool_Failures > 0 then
         Report ("Total gnatcheck failures:" & Tool_Failures'Img);
         Report_EOL;
      end if;

   end Print_Failure_Info;

   -------------------------
   -- Print_Report_Header --
   -------------------------

   procedure Print_Report_Header is
      Time_Of_Check   : constant Time := Clock;
      Month_Of_Check  : constant Month_Number := Month (Time_Of_Check);
      Day_Of_Check    : constant Day_Number   := Day (Time_Of_Check);
      Sec_Of_Check    : constant Day_Duration := Seconds (Time_Of_Check);

      Hour_Of_Chech   :          Integer range 0 .. 23;
      Minute_Of_Check :          Integer range 0 .. 59;
      Seconds_In_Hour : constant Integer := 60 * 60;
   begin
      Report_No_EOL ("Rule checking report generated ");
      Report_No_EOL (Trim (Year (Time_Of_Check)'Img, Left) & '.');

      if Month_Of_Check < 10 then
         Report_No_EOL ("0");
      end if;

      Report_No_EOL (Trim (Month_Of_Check'Img, Left) & '.');

      if Day_Of_Check < 10 then
         Report_No_EOL ("0");
      end if;

      Report_No_EOL (Trim (Day_Of_Check'Img, Left) & ' ');

      Hour_Of_Chech   := Integer (Sec_Of_Check) / Seconds_In_Hour;
      Minute_Of_Check := (Integer (Sec_Of_Check) rem Seconds_In_Hour) / 60;

      if Hour_Of_Chech < 10 then
         Report_No_EOL ("0");
      end if;

      Report_No_EOL (Trim (Hour_Of_Chech'Img, Left) & ':');

      if Minute_Of_Check < 10 then
         Report_No_EOL ("0");
      end if;

      Report        (Trim (Minute_Of_Check'Img, Left));

      Report_No_EOL ("by ");
      Report_No_EOL ("GNATCHECK (built with ");
      Report_No_EOL (To_String (Asis.Implementation.ASIS_Implementor_Version));
      Report        (")");

      Report_EOL;
   end Print_Report_Header;

   ---------------------
   -- Print_Section_1 --
   ---------------------

   procedure Print_Section_1 is
      SF_Name : String_Access;
      --  Points to the name of the current source file. We use a string access
      --  value instead of using ASIS_UL.Source_Table.Short_Source_Name because
      --  of the performance reasons

      Next_Diagnosis : Diag_Id;

      Line_Pos : Natural := 0;
      Col_Pos  : Natural := 0;
      --  Max positions for lines and columns, are  needed to allign
      --  diagnoses in the report file
   begin

      if Output_Section_1
        and then
         not Short_Report
      then
         Report_EOL;
         Report ("-------- Start Section 1 ------------");
         Report ("   (compiler-style report, diagnoses are grouped by files,");
         Report ("    and for each file diagnoses are ordered by increasing");
         Report ("    the source location of the corresponding construct)");
         Report_EOL;
      end if;

      for SF in First_SF_Id .. Last_Source loop
         Next_Diagnosis := First_Diagnosis (SF);

         if Present (Next_Diagnosis) then

            SF_Name := new String'(Short_Source_Name (SF));

            if Output_Section_1
              and then
               not Full_Source_Locations
            then
               Compute_Alignment (SF, Line_Pos, Col_Pos);
            end if;

            while Present (Next_Diagnosis) loop

               if Output_Section_1 then

                  if Full_Source_Locations
                     and then Diag_Table (Next_Diagnosis).Rule not in
                              Warning_Diags .. Restriction_Diags
                  then
                     Report_No_EOL
                       (Get_String (Diag_Table (Next_Diagnosis).SLOC) & ' ');
                  else
                     Report_No_EOL (SF_Name.all & ':');
                     Report_No_EOL
                       (Line_Col
                         (D        => Next_Diagnosis,
                          Line_Pos => Line_Pos,
                          Col_Pos  => Col_Pos) & ": ");
                  end if;

                  Report (Text_Diag (Next_Diagnosis));
               end if;

               --  This generates the diagnostic messages into Stdout
               if not Quiet_Mode then
                  if Diag_Table (Next_Diagnosis).Rule not in
                     Warning_Diags .. Restriction_Diags
                  then
                     Put_Line
                       (Get_String (Diag_Table (Next_Diagnosis).SLOC) & ": " &
                        Text_Diag (Next_Diagnosis));
                  else
                     Put (SF_Name.all & ':');
                     Put (Image (Integer (Diag_Table (Next_Diagnosis).Line)) &
                          ':');
                     Put (Image (Integer (Diag_Table (Next_Diagnosis).Col)) &
                          ' ');
                     Put_Line  (Text_Diag (Next_Diagnosis));
                  end if;

               end if;

               Next_Diagnosis := Diag_Table (Next_Diagnosis).Next_Diag;
            end loop;

            Free (SF_Name);
         end if;

      end loop;

      if not Short_Report then
         Report ("-------- End Section 1 ------------");
         Report_EOL;
      end if;

   end Print_Section_1;

   ---------------------
   -- Print_Section_2 --
   ---------------------

   procedure Print_Section_2 is

      procedure Print_Rule_Matches (Rule : Rule_Id);
      --  Prints out matches for a given rule detected in all the files
      --  that have been processed

      procedure Print_Rule_Matches (Rule : Rule_Id) is
         SF_Name : String_Access;
         --  Points to the name of the current source file. We use a string
         --  access value instead of using
         --  ASIS_UL.Source_Table.Short_Source_Name because of the performance
         --  reasons

         Next_Diagnosis : Diag_Id;

         No_Matches : Boolean := True;

      begin
         for SF in First_SF_Id .. Last_Source loop
            SF_Name        := new String'(Short_Source_Name (SF));
            Next_Diagnosis := First_Rule_Diagnosis (SF, Rule);

            if Present (Next_Diagnosis) then
               Report ("Matches detected in file " & SF_Name.all, 1);

               while Present (Next_Diagnosis) loop

                  if Full_Source_Locations then
                     Report (Get_String (Diag_Table (Next_Diagnosis).SLOC), 2);
                  else
                     Report (Line_Col (Next_Diagnosis), 2);
                  end if;

                  Next_Diagnosis :=
                    Diag_Table (Next_Diagnosis).Next_Same_Rule_Diag;
               end loop;

               Report_EOL;

               No_Matches := False;

            end if;

            --  Report_EOL;
            Free (SF_Name);
         end loop;

         if No_Matches then
               Report ("No matches detected in processed files", 2);
         end if;

      end Print_Rule_Matches;

   begin
      if not Short_Report then
         Report_EOL;
         Report ("-------- Start Section 2 ------------");
         Report ("   (diagnoses are grouped by rules, and for each rule -");
         Report ("    by files, and for each file - by increasing the source");
         Report ("    location of the corresponding construct)");
         Report_EOL;
      end if;

      for Rule in All_Rules.First .. All_Rules.Last loop

         if All_Rules.Table (Rule).Rule_State /= Disabled then

            --  Rule identification info, something more smart should be
            --  printed out here  ???

            Report (All_Rules.Table (Rule).Help_Info.all);
            Print_Rule_Matches (Rule);
            Report_EOL;
         end if;

      end loop;

      --  Compiler-made checks:

      if Use_gnaty_Option then
         Report ("Compiler style checks");
         Print_Rule_Matches (Style_Diags);
      end if;

      if Use_gnatw_Option then
         Report ("Compiler warnings");
         Print_Rule_Matches (Warning_Diags);
      end if;

      if Check_Restrictions then
         Report ("Compiler-checked restrictions");
         Print_Rule_Matches (Restriction_Diags);
      end if;

      if not Short_Report then
         Report ("-------- End Section 2 ------------");
         Report_EOL;
      end if;

   end Print_Section_2;

   ---------------------
   -- Print_Section_3 --
   ---------------------

   procedure Print_Section_3 is
      SF_Name : String_Access;
      --  Points to the name of the current source file. We use a string access
      --  value instead of using ASIS_UL.Source_Table.Short_Source_Name because
      --  of the performance reasons

      Next_Diagnosis : Diag_Id;

      procedure Print_Rule_Matches (Rule : Rule_Id; SF : SF_Id);
      --  Prints out matches for a given rule detected in the given file

      procedure Print_Rule_Matches (Rule : Rule_Id; SF : SF_Id) is
         Next_Diag : Diag_Id;
      begin
         Next_Diag := First_Rule_Diagnosis (SF, Rule);

         if Present (Next_Diag) then

            while Present (Next_Diag) loop

               if Full_Source_Locations then
                  Report (Get_String (Diag_Table (Next_Diagnosis).SLOC), 2);
               else
                  Report (Line_Col (Next_Diag), 2);
               end if;

               Next_Diag := Diag_Table (Next_Diag).Next_Same_Rule_Diag;
            end loop;

         else
            Report ("No matches detected", 2);
         end if;

      end Print_Rule_Matches;

   begin
      if not Short_Report then
         Report_EOL;
         Report ("-------- Start Section 3 ------------");
         Report ("   (diagnoses are grouped by files, and for each file they");
         Report ("    are first grouped by rules and then - by increasing");
         Report ("    the source location of the corresponding construct)");
         Report_EOL;
      end if;

--      for SF in First_SF_Id .. Last_Argument_Source loop
      for SF in First_SF_Id .. Last_Source loop
         Next_Diagnosis := First_Diagnosis (SF);
         SF_Name        := new String'(Short_Source_Name (SF));

         if Present (Next_Diagnosis) then

            Report ("Matches detected in file " & SF_Name.all);

            for Rule in All_Rules.First .. All_Rules.Last loop

               if All_Rules.Table (Rule).Rule_State /= Disabled then

                  --  Rule identification info, something more smart should be
                  --  printed out here  ???

                  Report (All_Rules.Table (Rule).Help_Info.all, 1);
                  Print_Rule_Matches (Rule, SF);
                  Report_EOL;
               end if;

            end loop;

            Report_EOL;

            --  Compiler-made checks:

            if Use_gnaty_Option then
               Report ("Compiler style checks");
               Print_Rule_Matches (Style_Diags, SF);
            end if;

            if Use_gnatw_Option then
               Report ("Compiler warnings");
               Print_Rule_Matches (Warning_Diags, SF);
            end if;

            if Check_Restrictions then
               Report ("Compiler-checked restrictions");
               Print_Rule_Matches (Restriction_Diags, SF);
            end if;

         elsif Source_Status (SF) = Processed then
            Report ("No matches for enabled rules detected in file " &
                     SF_Name.all);
            Report_EOL;
         end if;

         Free (SF_Name);

      end loop;

      if not Short_Report then
         Report ("-------- End Section 3 ------------");
      end if;

   end Print_Section_3;

   ----------------------------
   -- Print_Sections_Summary --
   ----------------------------

   procedure Print_Sections_Summary is
   begin
      Report ("This report contains following sections:");
      Report_EOL;

      Report_No_EOL ("Section 1 - ");

      if Output_Section_1 then
         Report ("compiler-style report, diagnoses are grouped by files and");
         Report ("            for each file ordered by line numbers");

      else
         Report ("skipped");
      end if;

      Report_No_EOL ("Section 2 - ");

      if Output_Section_2 then
         Report ("diagnoses are grouped by rules, then - by files and then -");
         Report ("            by line numbers");
      else
         Report ("skipped");
      end if;

      Report_No_EOL ("Section 3 - ");

      if Output_Section_3 then
         Report ("diagnoses are grouped by files, then - by rules and then -");
         Report ("            by line numbers");
      else
         Report ("skipped");
      end if;

   end Print_Sections_Summary;

   -----------------------
   -- Print_Source_List --
   -----------------------

   procedure Print_Source_List is
   begin
      Report_EOL;

      Report ("Checked argument sources:");

      for SF in First_SF_Id .. Last_Argument_Source loop
         Report_No_EOL (Short_Source_Name (SF), 1);

         if Source_Status (SF) = Not_A_Legal_Source then
            Report (" - illegal source, no check is made");
         else
            Report_EOL;
         end if;

      end loop;

      if Gnatcheck.Global_State.Buld_Call_Graph
        and then
         Last_Argument_Source < Last_Source
      then
         Report ("Additional sources analyzed to check global rules:");

         for SF in Last_Argument_Source + 1 .. Last_Source loop
            Report_No_EOL (Short_Source_Name (SF), 1);

            if Source_Status (SF) = Not_A_Legal_Source then
               Report (" - illegal source, no check is made");
            else
               Report_EOL;
            end if;

         end loop;
      end if;

      Report_EOL;

   end Print_Source_List;

   ------------------------------------------
   -- Process_Report_File_Format_Parameter --
   ------------------------------------------
   procedure Process_Report_File_Format_Parameter
     (Parameter :     String;
      Success   : out Boolean)
   is
   begin
      Success := True;

      if Parameter = "" then
         Short_Report := True;
         return;
      end if;

      if All_Section_On then
         All_Section_On  := False;
         Output_Section_1 := False;
         Output_Section_2 := False;
         Output_Section_3 := False;
      end if;

      for J in Parameter'Range loop

         case Parameter (J) is
            when '1' =>
               Output_Section_1 := True;
            when '2' =>
               Output_Section_2 := True;
            when '3' =>
               Output_Section_3 := True;
            when others =>
               Success := False;
               Error ("Wrong parameter of '-s' option: " & Parameter);
               return;
         end case;

      end loop;

   end Process_Report_File_Format_Parameter;

   -------------------------
   -- Set_First_Diagnosis --
   -------------------------

   procedure Set_First_Diagnosis (SF : SF_Id; D : Diag_Id) is
   begin
      Mapping_Table (SF) (All_Diags).First := D;
   end Set_First_Diagnosis;

   ------------------------------
   -- Set_First_Rule_Diagnosis --
   ------------------------------

   procedure Set_First_Rule_Diagnosis (SF : SF_Id; R : Rule_Id; D : Diag_Id) is
   begin
      Mapping_Table (SF) (R).First := D;
   end Set_First_Rule_Diagnosis;

   ------------------------
   -- Set_Last_Diagnosis --
   ------------------------

   procedure Set_Last_Diagnosis (SF : SF_Id; D : Diag_Id) is
   begin
      Mapping_Table (SF) (All_Diags).Last := D;
   end Set_Last_Diagnosis;

   -----------------------------
   -- Set_Last_Rule_Diagnosis --
   -----------------------------

   procedure Set_Last_Rule_Diagnosis (SF : SF_Id; R : Rule_Id; D : Diag_Id) is
   begin
      Mapping_Table (SF) (R).Last := D;
   end Set_Last_Rule_Diagnosis;

   ----------------------------
   -- Store_Compiler_Message --
   ----------------------------

   procedure Store_Compiler_Message
     (In_SF        : SF_Id;
      Line_Num     : Natural;
      Col_Num      : Natural;
      Message      : String_Loc;
      Message_Kind : Compiler_Message_Kinds)
   is
      For_Rule : Rule_Id;
      --  Artificial Rule_Id for storing the compiler message
   begin
      case Message_Kind is
         when Not_A_Compiler_Nessage =>
            pragma Assert (False);
            return;
         when General_Warning =>
            For_Rule := Warning_Diags;
         when Style =>
            For_Rule := Style_Diags;
         when Restriction =>
            For_Rule := Restriction_Diags;
      end case;

      Store_Rule_Violation_Internal
        (For_Rule      => For_Rule,
         Line_Num      => Types.Physical_Line_Number (Line_Num),
         Col_Num       => Types.Column_Number (Col_Num),
         In_SF         => In_SF,
         Diagnosis_Num => 0,   --  temporary solution
         Diag_Text     => Message,
         Element_SLOC  => Nil_String_Loc);
   end Store_Compiler_Message;

   --------------------------
   -- Store_Rule_Violation --
   --------------------------

   procedure Store_Rule_Violation
     (For_Rule : Rule_Id;
      On       : GS_Node_Id)
   is

      --  A junk approach is used here - line and column numbers are
      --  computed from the string image of GNAT-style source reference.
      --  We should probably keep line and column numbers as a part of the
      --  global structure node structure

      SLOC : constant String := Get_String (Location (On));

      function Get_Line_Number return Types.Physical_Line_Number;
      --  Separates the line number from SLOC and returns it as the value
      --  of Physical_Line_Number

      function Get_Column_Number return Types.Column_Number;
      --  Separates the line number from SLOC and returns it as the value
      --  of Column_Number

      function Get_Line_Number return Types.Physical_Line_Number is
         First_Colon  : Positive;
         Second_Colon : Positive;
      begin
         First_Colon := Index (SLOC, ":");
         Second_Colon := Index (SLOC (First_Colon + 1 .. SLOC'Last), ":");

         return Types.Physical_Line_Number'Value
           (SLOC (First_Colon + 1 .. Second_Colon - 1));
      end Get_Line_Number;

      function Get_Column_Number return Types.Column_Number is
         Second_Colon : Positive;
         Third_Colon  : Natural;
      begin
         Second_Colon := Index (SLOC, ":");
         Second_Colon := Index (SLOC (Second_Colon + 1 .. SLOC'Last), ":");
         Third_Colon  := Index (SLOC (Second_Colon + 1 .. SLOC'Last), "[");

         if Third_Colon = 0 then
            Third_Colon := SLOC'Last;
         else
            Third_Colon := Third_Colon - 1;
         end if;

         return Types.Column_Number'Value
           (SLOC (Second_Colon + 1 .. Third_Colon));
      end Get_Column_Number;

      Line_Num : constant Types.Physical_Line_Number := Get_Line_Number;
      Col_Num  : constant Types.Column_Number        := Get_Column_Number;

   begin

      Store_Rule_Violation_Internal
        (For_Rule      => For_Rule,
         Line_Num      => Line_Num,
         Col_Num       => Col_Num,
         In_SF         => Enclosed_Source (On),
         Diagnosis_Num => 0, --  temporary solution
         Element_SLOC  => Location (On));

   end Store_Rule_Violation;

   procedure Store_Rule_Violation
     (For_Rule      : Rule_Id;
      On            : Element;
      In_SF         : SF_Id;
      Diagnosis_Num : Diagnosis_Variant := 0;
      Diag_Pars     : String_Loc;
      Element_SLOC  : String_Loc)
   is
      P        : constant Types.Source_Ptr := Sloc (Node (On));
      Line_Num : constant Types.Physical_Line_Number :=
        Get_Physical_Line_Number (P);
      Col_Num  : constant Types.Column_Number := Get_Column_Number (P);

   begin

      Store_Rule_Violation_Internal
        (For_Rule      => For_Rule,
         Line_Num      => Line_Num,
         Col_Num       => Col_Num,
         In_SF         => In_SF,
         Diagnosis_Num => Diagnosis_Num,
         Diag_Text     => Diag_Pars,
         Element_SLOC  => Element_SLOC);

   end Store_Rule_Violation;

   -----------------------------------
   -- Store_Rule_Violation_Internal --
   -----------------------------------

   procedure Store_Rule_Violation_Internal
     (For_Rule      : Rule_Id;
      Line_Num      : Types.Physical_Line_Number;
      Col_Num       : Types.Column_Number;
      In_SF         : SF_Id;
      Diagnosis_Num : Diagnosis_Variant := 0;
      Diag_Text     : String_Loc        := Nil_String_Loc;
      Element_SLOC  : String_Loc        := Nil_String_Loc)
   is
      New_Diag  : Diag_Id;
      Diag_Link : Diag_Id;
      Tmp       : Diag_Id;
      use Types;
      --  To make type operations visible in the body
   begin

      --  ??? Do we need to store the source file Id here?

      Rule_Violations.Append
        ((Rule                => For_Rule,
          SF                  => In_SF,
          Diagnosis_Num       => Diagnosis_Num,
          Line                => Line_Num,
          Col                 => Col_Num,
          Next_Diag           => No_Diag,
          Prev_Diag           => No_Diag,
          Next_Same_Rule_Diag => No_Diag,
          Prev_Same_Rule_Diag => No_Diag,
          Diag_Text           => Diag_Text,
          SLOC                => Element_SLOC));

      New_Diag := Rule_Violations.Last;

      --  And now we have to update the chains:

      Diag_Link := Last_Diagnosis (In_SF);

      if No (Diag_Link) then
         --  The first diagnosis for the given source

         Set_First_Diagnosis (In_SF, New_Diag);

         --  If this is the first diagnosis for the given source, it
         --  is the first diagnosis for the given rule in the given source
         --  as well.

         Set_First_Rule_Diagnosis (In_SF, For_Rule, New_Diag);

         Set_Last_Diagnosis (In_SF, New_Diag);
         Set_Last_Rule_Diagnosis (In_SF, For_Rule, New_Diag);
      else

         --  Set all diagnoses chain
         if For_Rule > All_Rules.Last
          or else
            All_Rules.Table (For_Rule).all in Global_Rule_Template'Class
         then
            Diag_Link := First_Diagnosis (In_SF);

            while Present (Diag_Link)
              and then
                 (Line (Diag_Link) < Line (New_Diag)
                 or else
                  (Line (Diag_Link) = Line (New_Diag)
                  and then
                   Col (Diag_Link) < Col (New_Diag)))
            loop
               Diag_Link := Diag_Table (Diag_Link).Next_Diag;
            end loop;

            if No (Diag_Link) then
               --  So the new diagnosis is the rightmost in this file
               Diag_Link                        := Last_Diagnosis (In_SF);
               Diag_Table (New_Diag).Prev_Diag  := Diag_Link;
               Diag_Table (Diag_Link).Next_Diag := New_Diag;
               Set_Last_Diagnosis (In_SF, New_Diag);
            else
               Tmp := Diag_Table (Diag_Link).Prev_Diag;
               --  We have in insert the new diagnosis between Tmp and
               --  Diag_Link

               if No (Tmp) then
                  --  The new diagnosis is the leftmost for this file
                  Set_First_Diagnosis (In_SF, New_Diag);

                  Diag_Table (New_Diag).Next_Diag  := Diag_Link;
                  Diag_Table (Diag_Link).Prev_Diag := New_Diag;
               else
                  Diag_Table (Tmp).Next_Diag  := New_Diag;

                  Diag_Table (New_Diag).Prev_Diag := Tmp;
                  Diag_Table (New_Diag).Next_Diag := Diag_Link;

                  Diag_Table (Diag_Link).Prev_Diag  := New_Diag;

               end if;

            end if;

         else
            --  Diag_Link points to the last diagnosis!
            Diag_Table (New_Diag).Prev_Diag  := Diag_Link;
            Diag_Table (Diag_Link).Next_Diag := New_Diag;
            Set_Last_Diagnosis (In_SF, New_Diag);
         end if;

         --  Update the rule chain

         if For_Rule > All_Rules.Last
           or else
            All_Rules.Table (For_Rule).all in Global_Rule_Template'Class
         then
            Diag_Link := First_Rule_Diagnosis (In_SF, For_Rule);

            if No (Diag_Link) then
               --  First diagnosis for the given rule
               Set_First_Rule_Diagnosis (In_SF, For_Rule, New_Diag);
               Set_Last_Rule_Diagnosis  (In_SF, For_Rule, New_Diag);
            else

               while Present (Diag_Link)
                 and then
                     (Line (Diag_Link) < Line (New_Diag)
                     or else
                      (Line (Diag_Link) = Line (New_Diag)
                      and then
                       Col (Diag_Link) < Col (New_Diag)))
               loop
                  Diag_Link := Diag_Table (Diag_Link).Next_Same_Rule_Diag;
               end loop;

               if No (Diag_Link) then
                  --  So the new diagnosis is the rightmost in this file
                  --  for the given rule

                  Diag_Link := Last_Rule_Diagnosis (In_SF, For_Rule);
                  Diag_Table (New_Diag).Prev_Same_Rule_Diag  := Diag_Link;
                  Diag_Table (Diag_Link).Next_Same_Rule_Diag := New_Diag;
                  Set_Last_Rule_Diagnosis (In_SF, For_Rule, New_Diag);
               else
                  Tmp := Diag_Table (Diag_Link).Prev_Same_Rule_Diag;
                  --  We have in insert the new diagnosis between Tmp and
                  --  Diag_Link

                  if No (Tmp) then
                     --  The new diagnosis is the leftmost for this file
                     Set_First_Rule_Diagnosis    (In_SF, For_Rule, New_Diag);

                     Diag_Table (New_Diag).Next_Same_Rule_Diag  := Diag_Link;
                     Diag_Table (Diag_Link).Prev_Same_Rule_Diag := New_Diag;
                  else
                     Diag_Table (Tmp).Next_Same_Rule_Diag := New_Diag;

                     Diag_Table (New_Diag).Prev_Same_Rule_Diag := Tmp;
                     Diag_Table (New_Diag).Next_Same_Rule_Diag := Diag_Link;

                     Diag_Table (Diag_Link).Prev_Same_Rule_Diag := New_Diag;

                  end if;

               end if;
            end if;

         else
            Diag_Link := Last_Rule_Diagnosis (In_SF, For_Rule);

            if No (Diag_Link) then
               --  The first diagnosis for the given rule in the given source
               Set_First_Rule_Diagnosis (In_SF, For_Rule, New_Diag);
            else
               Diag_Table (New_Diag).Prev_Same_Rule_Diag  := Diag_Link;
               Diag_Table (Diag_Link).Next_Same_Rule_Diag := New_Diag;
            end if;

            Set_Last_Rule_Diagnosis (In_SF, For_Rule, New_Diag);

         end if;

      end if;

   end Store_Rule_Violation_Internal;

   ---------------
   -- Text_Diag --
   ---------------

   function Text_Diag (D : Diag_Id) return String is
   begin

      if Diag_Table (D).Rule in Warning_Diags .. Restriction_Diags then
         return Get_String (Diag_Table (D).Diag_Text);
      else
         return Insert_Actuals
                  (Message => Select_Variant
                             (Message =>
                                 All_Rules.Table (Diag_Table (D).Rule).
                                    Diagnosis.all,
                              Num     => Diag_Table (D).Diagnosis_Num),

                   Actuals => Diag_Table (D).Diag_Text);
      end if;
   end Text_Diag;

end Gnatcheck.Diagnoses;
