From: Yannick Moy <moy@adacore.com>
Date: Wed, 3 Jul 2019 08:16:20 +0000 (+0000)
Subject: [Ada] Suppress warnings in generic instantiations with pragma Warnings
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=3f3dbb7b933c051e58544c8f3f98f587b498e5f5;p=gcc.git

[Ada] Suppress warnings in generic instantiations with pragma Warnings

Warnings issued by GNAT or GNATprove inside generic instantiations can
now be suppressed by using pragma Warnings Off/On around the instance.
This has mostly an effect on GNATprove, since GNAT typically does not
issue warnings on instantiations, only on the generic code itself.

2019-07-03  Yannick Moy  <moy@adacore.com>

gcc/ada/

	* erroutc.adb (Sloc_In_Range): New function to determine whether
	the range of a pragma Warnings covers a location, taking
	instantiations into account.

From-SVN: r272985
---

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 2824f44c2f3..859380f9aa3 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,9 @@
+2019-07-03  Yannick Moy  <moy@adacore.com>
+
+	* erroutc.adb (Sloc_In_Range): New function to determine whether
+	the range of a pragma Warnings covers a location, taking
+	instantiations into account.
+
 2019-07-03  Johannes Kanig  <kanig@adacore.com>
 
 	* osint.ads, osint.adb (Get_First_Main_File_Name): New routine
diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb
index 57a169b471b..0c8ef5de7cc 100644
--- a/gcc/ada/erroutc.adb
+++ b/gcc/ada/erroutc.adb
@@ -56,6 +56,12 @@ package body Erroutc is
    --  wild card chars (*). The entire pattern must match the entire string.
    --  Case is ignored in the comparison (so X matches x).
 
+   function Sloc_In_Range (Loc, Start, Stop : Source_Ptr) return Boolean;
+   --  Return whether Loc is in the range Start .. Stop, taking instantiation
+   --  locations of Loc into account. This is useful for suppressing warnings
+   --  from generic instantiations by using pragma Warnings around generic
+   --  instances, as needed in GNATprove.
+
    ---------------
    -- Add_Class --
    ---------------
@@ -1588,6 +1594,24 @@ package body Erroutc is
       end if;
    end Set_Warnings_Mode_On;
 
+   -------------------
+   -- Sloc_In_Range --
+   -------------------
+
+   function Sloc_In_Range (Loc, Start, Stop : Source_Ptr) return Boolean is
+      Cur_Loc : Source_Ptr := Loc;
+
+   begin
+      while Cur_Loc /= No_Location loop
+         if Start <= Cur_Loc and then Cur_Loc <= Stop then
+            return True;
+         end if;
+         Cur_Loc := Instantiation_Location (Cur_Loc);
+      end loop;
+
+      return False;
+   end Sloc_In_Range;
+
    --------------------------------
    -- Validate_Specific_Warnings --
    --------------------------------
@@ -1652,7 +1676,7 @@ package body Erroutc is
             --  location is in range of a specific non-configuration pragma.
 
             if SWE.Config
-              or else (SWE.Start <= Loc and then Loc <= SWE.Stop)
+              or else Sloc_In_Range (Loc, SWE.Start, SWE.Stop)
             then
                if Matches (Msg.all, SWE.Msg.all)
                  or else Matches (Tag, SWE.Msg.all)
@@ -1691,8 +1715,8 @@ package body Erroutc is
       --  Loop through table of ON/OFF warnings
 
       for J in Warnings.First .. Warnings.Last loop
-         if Warnings.Table (J).Start <= Loc
-           and then Loc <= Warnings.Table (J).Stop
+         if Sloc_In_Range (Loc, Warnings.Table (J).Start,
+                                Warnings.Table (J).Stop)
          then
             return Warnings.Table (J).Reason;
          end if;