diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/ada/erroutc.adb | 30 |
2 files changed, 33 insertions, 3 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 2824f44..859380f 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 57a169b..0c8ef5d 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; |