------------------------------------------------------------------------------
--                                                                          --
--                          GNATCHECK COMPONENTS                            --
--                                                                          --
--                  G N A T C H E C K . E X E M P T I O N                   --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                     Copyright (C) 2009-2010, 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).             --
--                                                                          --
------------------------------------------------------------------------------

pragma Ada_2005;

with Ada.Characters.Handling;    use Ada.Characters.Handling;
--  with Ada.Wide_Text_IO;           use Ada.Wide_Text_IO;

with GNAT.OS_Lib;                use GNAT.OS_Lib;

with Table;

with Asis.Elements;              use Asis.Elements;
with Asis.Expressions;           use Asis.Expressions;
with Asis.Text;                  use Asis.Text;

with ASIS_UL.Misc;               use ASIS_UL.Misc;
with ASIS_UL.Output;             use ASIS_UL.Output;

with Gnatcheck.Compiler;         use Gnatcheck.Compiler;
with Gnatcheck.Diagnoses;        use Gnatcheck.Diagnoses;
with Gnatcheck.Ids;              use Gnatcheck.Ids;
with Gnatcheck.Rules;            use Gnatcheck.Rules;
with Gnatcheck.Rules.Rule_Table; use Gnatcheck.Rules.Rule_Table;

package body Gnatcheck.Exemption is

   type Exemption_Kinds is
     (Not_An_Exemption,
      Exempt_On,
      Exempt_Off);

   function Get_Exemption_Kind (Image : Wide_String) return Exemption_Kinds;
   --  Returns Exemption_Kinds value represented by Image. Returns
   --  Not_An_Exemption if Image does not represent a valid exemption kind.

   -------------------------------------------
   -- Storage for compiler check exemptions --
   -------------------------------------------

   type Compiler_Rule_Exemption_Info;
   type  Compiler_Rule_Exemption_Info_Access is access
     Compiler_Rule_Exemption_Info;

   type Compiler_Rule_Exemption_Info is record

      Start_Line : Natural;
      Start_Col  : Natural;
      End_Line   : Natural;
      End_Col    : Natural;
      --  Exemption section

      Justification : String_Loc;

      Detected : Natural;
      --  Number of the diagnoses generated for exempted rule

      Next_Exemption_Section : Compiler_Rule_Exemption_Info_Access;

   end record;

   type Compiler_Check_Exemption_Sections is record
      Warning_Exemptions     : Compiler_Rule_Exemption_Info_Access;
      Style_Exemptions       : Compiler_Rule_Exemption_Info_Access;
      Restriction_Exemptions : Compiler_Rule_Exemption_Info_Access;
   end record;

   package Compiler_Checks_Exemptions_Table is  new Table.Table (
     Table_Component_Type => Compiler_Check_Exemption_Sections,
     Table_Index_Type     => SF_Id,
     Table_Low_Bound      => First_SF_Id,
     Table_Initial        => 10000,
     Table_Increment      => 100,
     Table_Name           => "compiler check exemptions database");

   Compiler_Checks_Exemptions : Compiler_Checks_Exemptions_Table.Table_Ptr
     renames Compiler_Checks_Exemptions_Table.Table;

   Parsed_File : SF_Id := No_SF_Id;
   --  The file that is currently parsed and that contains Annotate pragmas
   --  being processed.

   Warning_Excemption     : Compiler_Rule_Exemption_Info_Access := null;
   Style_Excemption       : Compiler_Rule_Exemption_Info_Access := null;
   Restriction_Excemption : Compiler_Rule_Exemption_Info_Access := null;
   --  Points to the last excemption section for the corresponding compiler
   --  check for currently processed file. Equals to null if no such section
   --  has been encountered yet. If the section has not been closed (that means
   --  that the corresponding check is in exempted state) End_Line and End_Col
   --  fields are equal to 0.

   function Is_Exempted (Check : Compiler_Checks) return Boolean;
   --  Checks if the corresponding compiler check is exempted.

   function Exemption_Start_Line (Check : Compiler_Checks) return  Natural;
   function Exemption_Start_Col  (Check : Compiler_Checks) return  Natural;
   --  Returns the line/column of the Annotate pragma that turns the argument
   --  compiler check into exempted state. Returns 0 if the check is not
   --  exempted.

   procedure Set_Check_Exemption_Section_Start
     (For_Check     : Compiler_Checks;
      Line          : Natural;
      Col           : Natural;
      Justification : String_Loc);
   --  Creates a new record describing compiler check exemption section and
   --  stores it in Compiler_Checks_Exemptions. Stores the reference to this
   --  record in the corresponding ..._Ecemption global variable. Raises
   --  Fatal_Error if For_Check is equal to Not_A_Compiler_Nessage

   procedure Set_Check_Exemption_Section_End
     (For_Check : Compiler_Checks;
      Line      : Natural;
      Col       : Natural);
   --  Sets Lina and Col values as coordinates of the end of the current
   --  excemption section for check

   procedure Turn_Off_Exemption
     (For_Check : Compiler_Checks;
      Line      : Natural;
      Col       : Natural);
   --  Closes the currently opened exemption section for For_Check by defining
   --  the last line and last column by the section.

   procedure Compiler_Checks_Exemptions_Debug_Info;
   pragma Unreferenced (Compiler_Checks_Exemptions_Debug_Info);
   --  Prints out the current state of Compiler_Checks_Exemptions.

   ------------------------------------
   -- Check_Unclosed_Rule_Exemptions --
   ------------------------------------

   procedure Check_Unclosed_Rule_Exemptions
     (SF   : SF_Id;
      Unit : Asis.Element)
   is
      Comp_Span : constant Span := Compilation_Span (Unit);
   begin
      --  Very simple-minded implementation, diagnoses are not ordered
      --  according to SLOCs of unclosed exemptions

      for Rule in First_Rule .. All_Rules.Last loop

         if Is_Exempted (Rule) then
            Store_Diagnosis
              (Text           => Short_Source_Name (SF)        & ':'    &
                                 Image (Exemption_Line (Rule)) & ':'    &
                                 Image (Exemption_Col  (Rule)) & ": "   &
                                 "No matching 'exempt_OFF' annotation " &
                                 "for rule " & Rule_Name (Rule),
               Diagnosis_Kind => Exemption_Warning,
               SF             => SF);

--            SLOC_Error
--              (Message => "No matching 'exempt_OFF' annotation for rule " &
--                          Rule_Name (Rule),
--               SLOC    => Short_Source_Name (SF)        & ':' &
--                          Image (Exemption_Line (Rule)) & ':' &
--                          Image (Exemption_Col  (Rule)));

            if Exemption_Violations (Rule) = 0 then
               Store_Diagnosis
                 (Text           => Short_Source_Name (SF)        & ':'  &
                                    Image (Exemption_Line (Rule)) & ':'  &
                                    Image (Exemption_Col  (Rule)) & ": " &
                                    "no detection for rule "             &
                                    Rule_Name (Rule),
                  Diagnosis_Kind => Exemption_Warning,
                  SF             => SF);

--               SLOC_Error
--                 (Message => "no detection for rule " & Rule_Name (Rule),
--                  SLOC    => Short_Source_Name (SF)        & ':' &
--                             Image (Exemption_Line (Rule)) & ':' &
--                             Image (Exemption_Col  (Rule)));
            end if;

            Turn_Off_Exemption (Rule);
         end if;

      end loop;

      --  Compiler checks
      for Check in Compiler_Checks loop
         if Is_Exempted (Check) then
            Store_Diagnosis
              (Text           => Short_Source_Name (SF)               & ':'  &
                                 Image (Exemption_Start_Line (Check)) & ':'  &
                                 Image (Exemption_Start_Col  (Check)) & ": " &
                                 "No matching 'exempt_OFF' annotation "      &
                                 "for rule " & Rule_Name (Check),
               Diagnosis_Kind => Exemption_Warning,
               SF             => SF);

--            SLOC_Error
--              (Message => "No matching 'exempt_OFF' annotation for rule " &
--                          Rule_Name (Check),
--               SLOC    => Short_Source_Name (SF)        & ':' &
--                          Image (Exemption_Start_Line (Check)) & ':' &
--                          Image (Exemption_Start_Col  (Check)));

            Set_Check_Exemption_Section_End
              (Check,
               Comp_Span.Last_Line,
               Comp_Span.Last_Column);
         end if;
      end loop;

   end Check_Unclosed_Rule_Exemptions;

   ---------------------
   -- Clean_Exemption --
   ---------------------

   procedure Clean_Exemption (Exemp : in out Exemption_Info) is
   begin
      Exemp.Line          := 0;
      Exemp.Col           := 0;
      Exemp.Justification := Nil_String_Loc;
      Exemp.Detected      := 0;
   end Clean_Exemption;

   -------------------------------------------
   -- Compiler_Checks_Exemptions_Debug_Info --
   -------------------------------------------

   procedure Compiler_Checks_Exemptions_Debug_Info is
      Next_Section : Compiler_Rule_Exemption_Info_Access;
   begin
      Info ("***Compiler rules excemption sections***");

      for SF in Compiler_Checks_Exemptions_Table.First ..
                Compiler_Checks_Exemptions_Table.Last
      loop
         Info (Short_Source_Name (SF));

         if Compiler_Checks_Exemptions (SF).Warning_Exemptions = null then
            Info ("no warning exemption section for this file", 1);
         else
            Info ("warning exemption sections", 1);
            Next_Section := Compiler_Checks_Exemptions (SF).Warning_Exemptions;

            while Next_Section /= null loop
               Info (Image (Next_Section.Start_Line) & ':'   &
                     Image (Next_Section.Start_Col)  & " - " &
                     Image (Next_Section.End_Line)   & ':'   &
                     Image (Next_Section.End_Col), 2);

               Next_Section := Next_Section.Next_Exemption_Section;
            end loop;
         end if;

         if Compiler_Checks_Exemptions (SF).Style_Exemptions = null then
            Info ("no style check exemption section for this file", 1);
         else
            Info (" style check exemption sections", 1);
            Next_Section := Compiler_Checks_Exemptions (SF).Style_Exemptions;

            while Next_Section /= null loop
               Info (Image (Next_Section.Start_Line) & ':'   &
                     Image (Next_Section.Start_Col)  & " - " &
                     Image (Next_Section.End_Line)   & ':'   &
                     Image (Next_Section.End_Col), 2);

               Next_Section := Next_Section.Next_Exemption_Section;
            end loop;
         end if;

         if Compiler_Checks_Exemptions (SF).Restriction_Exemptions = null then
            Info ("no restriction exemption section for this file", 1);
         else
            Info ("restriction exemption sections", 1);
            Next_Section :=
              Compiler_Checks_Exemptions (SF).Restriction_Exemptions;

            while Next_Section /= null loop
               Info (Image (Next_Section.Start_Line) & ':'   &
                     Image (Next_Section.Start_Col)  & " - " &
                     Image (Next_Section.End_Line)   & ':'   &
                     Image (Next_Section.End_Col), 2);

               Next_Section := Next_Section.Next_Exemption_Section;
            end loop;
         end if;

         Info ("");
      end loop;
   end Compiler_Checks_Exemptions_Debug_Info;

   -----------------------------
   -- Exemption_Justification --
   -----------------------------

   function Exemption_Justification
     (Exemp : Exemption_Info)
      return  String_Loc
   is
   begin
      return Exemp.Justification;
   end Exemption_Justification;

   -------------------
   -- Exemption_Col --
   -------------------

   function Exemption_Col (Exemp : Exemption_Info) return Natural is
   begin
      return Exemp.Col;
   end Exemption_Col;

   --------------------
   -- Exemption_Line --
   --------------------

   function Exemption_Line (Exemp : Exemption_Info) return Natural is
   begin
      return Exemp.Line;
   end Exemption_Line;

   -------------------------
   -- Exemption_Start_Col --
   -------------------------

   function Exemption_Start_Col  (Check : Compiler_Checks) return Natural is
   begin
      case Check is
         when General_Warning =>
            return Warning_Excemption.Start_Col;
         when Style =>
            return Style_Excemption.Start_Col;
         when Restriction =>
            return Restriction_Excemption.Start_Col;
      end case;
   end Exemption_Start_Col;

   --------------------------
   -- Exemption_Start_Line --
   --------------------------

   function Exemption_Start_Line (Check : Compiler_Checks) return  Natural is
   begin
      case Check is
         when General_Warning =>
            return Warning_Excemption.Start_Line;
         when Style =>
            return Style_Excemption.Start_Line;
         when Restriction =>
            return Restriction_Excemption.Start_Line;
      end case;
   end Exemption_Start_Line;

   --------------------------
   -- Exemption_Violations --
   --------------------------

   function Exemption_Violations (Exemp : Exemption_Info) return Natural is
   begin
      return Exemp.Detected;
   end Exemption_Violations;

   ------------------------
   -- Get_Exemption_Kind --
   ------------------------

   function Get_Exemption_Kind (Image : Wide_String) return Exemption_Kinds is
      Result : Exemption_Kinds;
   begin

      if Image (Image'First) = '"' then
         Result :=
           Exemption_Kinds'Wide_Value
             (Image (Image'First + 1 .. Image'Last - 1));
      --  Old format of Annotate pragma. We have to cut out quotation marks
      else
         Result :=
           Exemption_Kinds'Wide_Value (Image);
      end if;

      return Result;
   exception
      when Constraint_Error =>
         return Not_An_Exemption;
   end Get_Exemption_Kind;

   --------------------------------
   -- Increase_Violation_Counter --
   --------------------------------

   procedure Increase_Violation_Counter (Exemp : in out Exemption_Info) is
   begin
      Exemp.Detected := Exemp.Detected + 1;
   end Increase_Violation_Counter;

   ------------------------------------
   -- Init_Compiler_Check_Exemptions --
   ------------------------------------

   procedure Init_Compiler_Check_Exemptions (SF : SF_Id) is
   begin
      Parsed_File            := SF;
      Warning_Excemption     := null;
      Style_Excemption       := null;
      Restriction_Excemption := null;
   end Init_Compiler_Check_Exemptions;

   --------------------------------------------
   -- Init_Compiler_Check_Exemptions_Storage --
   --------------------------------------------

   procedure Init_Compiler_Check_Exemptions_Storage is
   begin
      Compiler_Checks_Exemptions_Table.Set_Last (Last_Argument_Source);

      for SF in First_SF_Id .. Last_Argument_Source loop
         Compiler_Checks_Exemptions (SF) := (null, null, null);
      end loop;

   end Init_Compiler_Check_Exemptions_Storage;

   -----------------
   -- Is_Exempted --
   -----------------

   function Is_Exempted (Check : Compiler_Checks) return Boolean is
   begin
      case Check is
         when General_Warning =>
            return Warning_Excemption /= null
                  and then
                   Warning_Excemption.End_Line = 0;
         when Style =>
            return Style_Excemption /= null
                  and then
                   Style_Excemption.End_Line = 0;
         when Restriction =>
            return Restriction_Excemption /= null
                  and then
                   Restriction_Excemption.End_Line = 0;
      end case;

   end Is_Exempted;

   -------------------------
   -- Is_Exemption_Pragma --
   -------------------------

   function Is_Exemption_Pragma (El : Asis.Element) return Boolean is
      Result : Boolean := False;
   begin

      if Pragma_Kind (El) = An_Implementation_Defined_Pragma
        and then
         To_Lower (To_String (Pragma_Name_Image (El))) = "annotate"
      then

         declare
            Pragma_Args : constant Asis.Element_List :=
              Pragma_Argument_Associations (El);
            --  Always non-empty for Annotate pragma!
            First_Par : Asis.Element;
         begin
            First_Par := Pragma_Args (Pragma_Args'First);
            First_Par := Actual_Parameter (First_Par);

            if To_Lower (To_String (Name_Image (First_Par))) = "gnatcheck" then
               Result := True;
            end if;
         end;

      end if;

      return Result;
   end Is_Exemption_Pragma;

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

   function Present (Exemp : Exemption_Info) return Boolean is
   begin
      return Exemp.Line > 0;
   end Present;

   ------------------------------
   -- Process_Exemption_Pragma --
   ------------------------------

   procedure Process_Exemption_Pragma (El : Asis.Element) is
      Pragma_Args : constant Asis.Element_List :=
        Pragma_Argument_Associations (El);

      First_Idx   : constant Natural := Pragma_Args'First;
      Next_Arg    :          Asis.Element;
      Tmp_Str     :          String_Access;
      Exem_Span   :          Asis.Text.Span;
      In_Instance : constant Boolean := Is_Part_Of_Instance (El);
      SF          : constant SF_Id := File_Find (El);

      Rule           : Rule_Id;
      Compiler_Check : Compiler_Message_Kinds := Not_A_Compiler_Nessage;
      Exemption_Kind : Exemption_Kinds;
   begin

      --  First, analyse the pragma format:
      --
      --  1. Check that we have at least three parameters

      if Pragma_Args'Length < 3 then
         if not In_Instance then
            Store_Diagnosis
              (Text           => Build_GNAT_Location (El) &
                                 "too few parameters for exemption, ignored",
               Diagnosis_Kind => Exemption_Warning,
               SF             => SF);

--            SLOC_Error ("too few parameters for exemption, ignored", El);
         end if;

         return;
      end if;

      --  2. Second parameter should be either "Exempt_On" or "Exempt_Off"

      Next_Arg := Pragma_Args (First_Idx + 1);
      Next_Arg := Actual_Parameter (Next_Arg);

      if Expression_Kind (Next_Arg) = A_String_Literal then
         Exemption_Kind := Get_Exemption_Kind (Value_Image (Next_Arg));
      elsif Expression_Kind (Next_Arg) = An_Identifier then
         Exemption_Kind := Get_Exemption_Kind (Name_Image (Next_Arg));
      end if;

      if Exemption_Kind = Not_An_Exemption then
         if not In_Instance then
            Store_Diagnosis
              (Text           => Build_GNAT_Location (Next_Arg) &
                                 "wrong exemption kind, ignored",
               Diagnosis_Kind => Exemption_Warning,
               SF             => SF);

--            SLOC_Error ("wrong exemption kind, ignored", Next_Arg);
         end if;

         return;
      end if;

      --  3. Third parameter should be the name of some existing rule:

      Next_Arg := Pragma_Args (First_Idx + 2);
      Next_Arg := Actual_Parameter (Next_Arg);

      if Expression_Kind (Next_Arg) = A_String_Literal then
         Tmp_Str := new String'(To_String (Value_Image (Next_Arg)));

         declare
            Rule_Name : constant String :=
              --  We have to cut out quotation marks
              To_Lower (Tmp_Str (Tmp_Str'First + 1 .. Tmp_Str'Last - 1));
         begin
            Rule := Get_Rule (Rule_Name);

            if No (Rule) then

               --  Check if we have a rule corresponding to a compiler check
               if Rule_Name = "restrictions" then
                  Compiler_Check := Restriction;
               elsif Rule_Name = "style_check" then
                  Compiler_Check := Style;
               elsif Rule_Name = "warnings" then
                  Compiler_Check := General_Warning;
               end if;

            end if;
         end;

         Free (Tmp_Str);
      else
         Rule := No_Rule;
      end if;

      if not (Present (Rule)
            or else
              Compiler_Check /= Not_A_Compiler_Nessage)
      then
         if not In_Instance then
            Store_Diagnosis
              (Text           => Build_GNAT_Location (Next_Arg) &
                                 "wrong rule name in exemption, ignored",
               Diagnosis_Kind => Exemption_Warning,
               SF             => SF);

--            SLOC_Error ("wrong rule name in exemption, ignored", Next_Arg);
         end if;

         return;
      end if;

      --  4. Fourth parameter, if present, should be a string.

      if Pragma_Args'Length >= 4 then
         Next_Arg := Pragma_Args (First_Idx + 3);
         Next_Arg := Actual_Parameter (Next_Arg);

         if Expression_Kind (Next_Arg) = A_String_Literal then
            Tmp_Str := new String'(To_String (Value_Image (Next_Arg)));
         end if;

         if Tmp_Str = null and then not In_Instance then
            Store_Diagnosis
              (Text           => Build_GNAT_Location (Next_Arg) &
                                 "exemption justification should be a string",
               Diagnosis_Kind => Exemption_Warning,
               SF             => SF);

--            SLOC_Error
--              ("exemption justification should be a string", Next_Arg);
         end if;

         --  5. Fourth parameter is ignored if exemption is turned OFF

         if Exemption_Kind = Exempt_Off and then not In_Instance then
            Store_Diagnosis
              (Text           => Build_GNAT_Location (Next_Arg) &
                                 "turning exemption OFF " &
                                 "does not need justification",
               Diagnosis_Kind => Exemption_Warning,
               SF             => SF);

--            SLOC_Error
--            ("turning exemption OFF does not need justification", Next_Arg);
         end if;

      end if;

      --  6. If exemption is turned ON, justification is expected

      if Exemption_Kind = Exempt_On
        and then
         Pragma_Args'Length = 3
        and then
         not In_Instance
      then
         Store_Diagnosis
           (Text           => Build_GNAT_Location (El) &
                              "turning exemption ON expects justification",
            Diagnosis_Kind => Exemption_Warning,
            SF             => SF);

--         SLOC_Error ("turning exemption ON expects justification", El);
      end if;

      if Pragma_Args'Length >= 5 then
         Next_Arg := Pragma_Args (First_Idx + 4);

         if not In_Instance then
            Store_Diagnosis
              (Text           => Build_GNAT_Location (Next_Arg) &
                                 "rule exemption may have " &
                                 " at most four parameters",
               Diagnosis_Kind => Exemption_Warning,
               SF             => SF);
--            SLOC_Error
--              ("rule exemption may have at most four parameters", Next_Arg);
         end if;

      end if;

      if not Is_Enable (All_Rules.Table (Rule).all)
         --  If Rule does not denote the enabled rule - nothing to do
        or else
         (In_Instance
         and then
          not Checked_On_Expanded_Code (All_Rules.Table (Rule).all))
      then
         return;
      end if;

      --  Now - processing of the exemption pragma:
      Exem_Span := Element_Span (El);

      case Exemption_Kind is
         when Exempt_On =>

            if Tmp_Str = null then
               Tmp_Str := new String'("""unjustified""");
            end if;

            if Present (Rule) then

               if Is_Exempted (Rule) then
                  if not In_Instance then
                     Store_Diagnosis
                       (Text           => Build_GNAT_Location (El) &
                                          "rule " & Rule_Name (Rule)     &
                                          " is already exempted at line" &
                                          Exemption_Line (Rule)'Img,
                        Diagnosis_Kind => Exemption_Warning,
                        SF             => SF);

--                     SLOC_Error
--                       ("rule " & Rule_Name (Rule)     &
--                        " is already exempted at line" &
--                        Exemption_Line (Rule)'Img, El);
                  end if;

                  return;
               end if;

               Set_Rule_Exemption_State
                 (For_Rule      => Rule,
                  Line          => Exem_Span.First_Line,
                  Col           => Exem_Span.First_Column,
                  Justification => Enter_String (Tmp_Str
                    (Tmp_Str'First + 1 .. Tmp_Str'Last - 1)));
            else
               --  Compiler checks
               if Is_Exempted (Compiler_Check) then
                  if not In_Instance then
                     Store_Diagnosis
                       (Text           => Build_GNAT_Location (El)       &
                                          "rule "                        &
                                          Rule_Name (Compiler_Check)     &
                                          " is already exempted at line" &
                                          Exemption_Start_Line
                                            (Compiler_Check)'Img,
                        Diagnosis_Kind => Exemption_Warning,
                        SF             => SF);

--                     SLOC_Error
--                       ("rule " & Rule_Name (Compiler_Check) &
--                        " is already exempted at line" &
--                        Exemption_Start_Line (Compiler_Check)'Img, El);
                  end if;

                  return;
               end if;

               Set_Check_Exemption_Section_Start
                 (For_Check     => Compiler_Check,
                  Line          => Exem_Span.First_Line,
                  Col           => Exem_Span.First_Column,
                  Justification => Enter_String (Tmp_Str
                    (Tmp_Str'First + 1 .. Tmp_Str'Last - 1)));
            end if;

            Free (Tmp_Str);

         when Exempt_Off =>

            if Present (Rule) then
               if not Is_Exempted (Rule) then
                  if not In_Instance then
                     Store_Diagnosis
                       (Text           => Build_GNAT_Location (El) &
                                          "rule " & Rule_Name (Rule) &
                                          " is not in exempted state",
                        Diagnosis_Kind => Exemption_Warning,
                        SF             => SF);

--                     SLOC_Error
--                       ("rule " & Rule_Name (Rule) &
--                        " is not in exempted state",
--                        El);
                  end if;

                  return;
               end if;

               if Exemption_Violations (Rule) = 0 and then not In_Instance then
                  Store_Diagnosis
                    (Text           => Build_GNAT_Location (El)               &
                                       "no detection for "                    &
                                       Rule_Name (Rule)                       &
                                       " rule in exemption section starting " &
                                       "at line" & Exemption_Line (Rule)'Img,
                     Diagnosis_Kind => Exemption_Warning,
                     SF             => SF);

--                  SLOC_Error
--                    ("no detection for "                           &
--                     Rule_Name (Rule)                              &
--                     " rule in exemption section starting at line" &
--                     Exemption_Line (Rule)'Img,
--                     El);
               end if;

               Turn_Off_Exemption (Rule);
            else
               --  Compiler checks
               if not Is_Exempted (Compiler_Check) then
                  if not In_Instance then
                     Store_Diagnosis
                       (Text           => Build_GNAT_Location (El)   &
                                          "rule "                    &
                                          Rule_Name (Compiler_Check) &
                                          " is not in exempted state",
                        Diagnosis_Kind => Exemption_Warning,
                        SF             => SF);

--                     SLOC_Error
--                       ("rule " & Rule_Name (Compiler_Check) &
--                        " is not in exempted state",
--                        El);
                  end if;

                  return;
               end if;

               --  For compiler checks, at this stage we cannot check at this
               --  stage if there are corresponding violations in exemption
               --  section

               Turn_Off_Exemption
                 (For_Check     => Compiler_Check,
                  Line          => Exem_Span.Last_Line,
                  Col           => Exem_Span.Last_Column);
            end if;

         when Not_An_Exemption =>
            pragma Assert (False);
            null;
      end case;

   end Process_Exemption_Pragma;

   -------------------------------------
   -- Set_Check_Exemption_Section_End --
   -------------------------------------

   procedure Set_Check_Exemption_Section_End
     (For_Check : Compiler_Checks;
      Line      : Natural;
      Col       : Natural)
   is
      Tmp : Compiler_Rule_Exemption_Info_Access;
   begin
      case For_Check is
         when General_Warning =>
            Tmp := Warning_Excemption;
         when Style =>
            Tmp := Style_Excemption;
         when Restriction =>
            Tmp := Restriction_Excemption;
      end case;

      Tmp.End_Line := Line;
      Tmp.End_Col  := Col;
   end Set_Check_Exemption_Section_End;

   ---------------------------------------
   -- Set_Check_Exemption_Section_Start --
   ---------------------------------------

   procedure Set_Check_Exemption_Section_Start
     (For_Check     : Compiler_Checks;
      Line          : Natural;
      Col           : Natural;
      Justification : String_Loc)
   is
      Tmp : Compiler_Rule_Exemption_Info_Access;
   begin
      case For_Check is
         when General_Warning =>
            if Compiler_Checks_Exemptions (Parsed_File).Warning_Exemptions =
               null
            then
               Compiler_Checks_Exemptions (Parsed_File).Warning_Exemptions :=
                  new Compiler_Rule_Exemption_Info;
               Warning_Excemption :=
                 Compiler_Checks_Exemptions (Parsed_File).Warning_Exemptions;
            else
               Warning_Excemption.Next_Exemption_Section :=
                  new Compiler_Rule_Exemption_Info;
               Warning_Excemption :=
                  Warning_Excemption.Next_Exemption_Section;
            end if;

            Tmp := Warning_Excemption;

         when Style =>
            if Compiler_Checks_Exemptions (Parsed_File).Style_Exemptions =
               null
            then
               Compiler_Checks_Exemptions (Parsed_File).Style_Exemptions :=
                  new Compiler_Rule_Exemption_Info;
               Style_Excemption :=
                 Compiler_Checks_Exemptions (Parsed_File).Style_Exemptions;
            else
               Style_Excemption.Next_Exemption_Section :=
                  new Compiler_Rule_Exemption_Info;
               Style_Excemption :=
                  Style_Excemption.Next_Exemption_Section;
            end if;

            Tmp := Style_Excemption;

         when Restriction =>
            if Compiler_Checks_Exemptions (Parsed_File).
              Restriction_Exemptions = null
            then
               Compiler_Checks_Exemptions (Parsed_File).
                 Restriction_Exemptions := new Compiler_Rule_Exemption_Info;
               Restriction_Excemption :=
                 Compiler_Checks_Exemptions
                   (Parsed_File).Restriction_Exemptions;
            else
               Restriction_Excemption.Next_Exemption_Section :=
                  new Compiler_Rule_Exemption_Info;
               Restriction_Excemption :=
                  Restriction_Excemption.Next_Exemption_Section;
            end if;

            Tmp := Restriction_Excemption;

      end case;

      Tmp.Start_Line             := Line;
      Tmp.Start_Col              := Col;
      Tmp.Justification          := Justification;
      Tmp.Detected               := 0;
      Tmp.Next_Exemption_Section := null;
   end Set_Check_Exemption_Section_Start;

   ------------------------
   -- Set_Exemption_Info --
   ------------------------

   procedure Set_Exemption_Info
     (Line          :     Natural := 0;
      Col           :     Natural := 0;
      Justification :     String_Loc := Nil_String_Loc;
      Value         : out Exemption_Info)
   is
   begin
      Value.Line          := Line;
      Value.Col           := Col;
      Value.Justification := Justification;
   end Set_Exemption_Info;

   ------------------------
   -- Turn_Off_Exemption --
   ------------------------

   procedure Turn_Off_Exemption
     (For_Check : Compiler_Checks;
      Line      : Natural;
      Col       : Natural)
   is
   begin
      case For_Check is
         when General_Warning =>
            Warning_Excemption.End_Line := Line;
            Warning_Excemption.End_Col  := Col;
         when Style =>
            Style_Excemption.End_Line := Line;
            Style_Excemption.End_Col  := Col;
         when Restriction =>
            Restriction_Excemption.End_Line := Line;
            Restriction_Excemption.End_Col  := Col;
      end case;
   end Turn_Off_Exemption;

end Gnatcheck.Exemption;
