[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
This commit is contained in:
Yannick Moy 2019-07-03 08:16:20 +00:00 committed by Pierre-Marie de Rodat
parent 10aea826da
commit 3f3dbb7b93
2 changed files with 33 additions and 3 deletions

View File

@ -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

View File

@ -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;