@@ -2028,7 +2028,7 @@ package body Errout is
if SWE.Open then
Error_Msg_N
("?.w?pragma Warnings Off with no matching Warnings On",
- SWE.Start);
+ SWE.Node);
-- Warn for ineffective Warnings (Off, ..)
@@ -2043,7 +2043,7 @@ package body Errout is
then
Error_Msg_N
("?.w?no warning suppressed by this pragma",
- SWE.Start);
+ SWE.Node);
end if;
end if;
end;
@@ -1660,9 +1660,10 @@ package body Erroutc is
Loc : constant Source_Ptr := Sinfo.Nodes.Sloc (Node);
begin
Specific_Warnings.Append
- ((Start => Node,
+ ((Start => Loc,
Msg => new String'(Msg),
Stop => Source_Last (Get_Source_File_Index (Loc)),
+ Node => Node,
Reason => Reason,
Open => True,
Used => Used,
@@ -1682,13 +1683,12 @@ package body Erroutc is
for J in 1 .. Specific_Warnings.Last loop
declare
SWE : Specific_Warning_Entry renames Specific_Warnings.Table (J);
- Start_Loc : constant Source_Ptr := Sinfo.Nodes.Sloc (SWE.Start);
begin
if Msg = SWE.Msg.all
- and then Loc > Start_Loc
+ and then Loc > SWE.Start
and then SWE.Open
- and then Get_Source_File_Index (Start_Loc) =
+ and then Get_Source_File_Index (SWE.Start) =
Get_Source_File_Index (Loc)
then
SWE.Stop := Loc;
@@ -1819,13 +1819,12 @@ package body Erroutc is
for J in Specific_Warnings.First .. Specific_Warnings.Last loop
declare
SWE : Specific_Warning_Entry renames Specific_Warnings.Table (J);
- Start_Loc : constant Source_Ptr := Sinfo.Nodes.Sloc (SWE.Start);
begin
-- Pragma applies if it is a configuration pragma, or if the
-- location is in range of a specific non-configuration pragma.
if SWE.Config
- or else Sloc_In_Range (Loc, Start_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)
@@ -347,11 +347,19 @@ package Erroutc is
-- which is the pattern to match for suppressing a warning.
type Specific_Warning_Entry is record
- Start : Node_Id;
+ Start : Source_Ptr;
Stop : Source_Ptr;
-- Starting and ending source pointers for the range. These are always
-- from the same source file.
+ Node : Node_Id;
+ -- Node for the pragma Warnings occurrence. We store it to compute the
+ -- enclosing subprogram if -gnatdJ is enabled and a message about this
+ -- clause needs to be emitted. Note that we cannot remove the Start
+ -- component above and use Sloc (Node) on message display instead
+ -- because -gnatD output can already have messed with slocs at the point
+ -- when warnings about ineffective clauses are emitted.
+
Reason : String_Id;
-- Reason string from pragma Warnings, or null string if none
From: Ronan Desplanques <desplanques@adacore.com> A recent change broke pragma Warnings when -gnatD is enabled in some cases. This patch fixes this by caching more slocs at times when it's known that they haven't been modified by -gnatD. gcc/ada/ * errout.adb (Validate_Specific_Warnings): Adapt to record definition change. * erroutc.adb (Set_Specific_Warning_On, Set_Specific_Warning_Off, Warning_Specifically_Suppressed): Likewise. * erroutc.ads: Change record definition. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/errout.adb | 4 ++-- gcc/ada/erroutc.adb | 11 +++++------ gcc/ada/erroutc.ads | 10 +++++++++- 3 files changed, 16 insertions(+), 9 deletions(-)