Skip to content

R
riscv-gcc-1
Commit fb2bd3a7 by Robert Dewar Committed by Arnaud Charlet
Options

errout.adb: Minor reformattin (Finalize): Take templates into account for warning suppression. 

2011-11-23  Robert Dewar  <dewar@adacore.com>

	* errout.adb: Minor reformattin (Finalize): Take templates into
	account for warning suppression.
	* errout.ads (Set_Specific_Warning_Off): Add Used parameter.
	* erroutc.adb: Minor reformatting (Finalize): Take generic
	templates into account for warning suppress.
	* erroutc.ads (Set_Specific_Warning_Off): Add Used parameter.
	* sem_prag.adb: Minor reformatting (Analyze_Pragma,
	case Warnings): Provide Used parameter in call to
	Set_Specific_Warnings_Off (to deal with generic template case).

From-SVN: r181658
parent a1092b48
Showing with 72 additions and 38 deletions
gcc/ada/ChangeLog
2011-11-23 Robert Dewar <dewar@adacore.com>
* errout.adb: Minor reformattin (Finalize): Take templates into
account for warning suppression.
* errout.ads (Set_Specific_Warning_Off): Add Used parameter.
* erroutc.adb: Minor reformatting (Finalize): Take generic
templates into account for warning suppress.
* erroutc.ads (Set_Specific_Warning_Off): Add Used parameter.
* sem_prag.adb: Minor reformatting (Analyze_Pragma,
case Warnings): Provide Used parameter in call to
Set_Specific_Warnings_Off (to deal with generic template case).
2011-11-23 Pascal Obry <obry@adacore.com>
* sem_prag.adb (Process_Convention): Better error message for
......
gcc/ada/errout.adb
......@@ -1286,30 +1286,37 @@ package body Errout is
Cur := First_Error_Msg;
while Cur /= No_Error_Msg loop
if not Errors.Table (Cur).Deleted
and then Warning_Specifically_Suppressed
(Errors.Table (Cur).Sptr, Errors.Table (Cur).Text)
then
Delete_Warning (Cur);
declare
CE : Error_Msg_Object renames Errors.Table (Cur);
-- If this is a continuation, delete previous messages
begin
if not CE.Deleted
and then
(Warning_Specifically_Suppressed (CE.Sptr, CE.Text)
or else
Warning_Specifically_Suppressed (CE.Optr, CE.Text))
then
Delete_Warning (Cur);
F := Cur;
while Errors.Table (F).Msg_Cont loop
F := Errors.Table (F).Prev;
Delete_Warning (F);
end loop;
-- If this is a continuation, delete previous messages
-- Delete any following continuations
F := Cur;
while Errors.Table (F).Msg_Cont loop
F := Errors.Table (F).Prev;
Delete_Warning (F);
end loop;
F := Cur;
loop
F := Errors.Table (F).Next;
exit when F = No_Error_Msg;
exit when not Errors.Table (F).Msg_Cont;
Delete_Warning (F);
end loop;
end if;
-- Delete any following continuations
F := Cur;
loop
F := Errors.Table (F).Next;
exit when F = No_Error_Msg;
exit when not Errors.Table (F).Msg_Cont;
Delete_Warning (F);
end loop;
end if;
end;
Cur := Errors.Table (Cur).Next;
end loop;
......
gcc/ada/errout.ads
......@@ -771,7 +771,8 @@ package Errout is
procedure Set_Specific_Warning_Off
(Loc : Source_Ptr;
Msg : String;
Config : Boolean)
Config : Boolean;
Used : Boolean := False)
renames Erroutc.Set_Specific_Warning_Off;
-- This is called in response to the two argument form of pragma Warnings
-- where the first argument is OFF, and the second argument is the prefix
......
gcc/ada/erroutc.adb
......@@ -1081,7 +1081,8 @@ package body Erroutc is
procedure Set_Specific_Warning_Off
(Loc : Source_Ptr;
Msg : String;
Config : Boolean)
Config : Boolean;
Used : Boolean := False)
is
begin
Specific_Warnings.Append
......@@ -1089,7 +1090,7 @@ package body Erroutc is
Msg => new String'(Msg),
Stop => Source_Last (Current_Source_File),
Open => True,
Used => False,
Used => Used,
Config => Config));
end Set_Specific_Warning_Off;
......@@ -1135,16 +1136,16 @@ package body Erroutc is
procedure Set_Warnings_Mode_Off (Loc : Source_Ptr) is
begin
-- Don't bother with entries from instantiation copies, since we
-- will already have a copy in the template, which is what matters
-- Don't bother with entries from instantiation copies, since we will
-- already have a copy in the template, which is what matters.
if Instantiation (Get_Source_File_Index (Loc)) /= No_Location then
return;
end if;
-- If last entry in table already covers us, this is a redundant
-- pragma Warnings (Off) and can be ignored. This also handles the
-- case where all warnings are suppressed by command line switch.
-- If last entry in table already covers us, this is a redundant pragma
-- Warnings (Off) and can be ignored. This also handles the case where
-- all warnings are suppressed by command line switch.
if Warnings.Last >= Warnings.First
and then Warnings.Table (Warnings.Last).Start <= Loc
......@@ -1152,9 +1153,9 @@ package body Erroutc is
then
return;
-- Otherwise establish a new entry, extending from the location of
-- the pragma to the end of the current source file. This ending
-- point will be adjusted by a subsequent pragma Warnings (On).
-- Otherwise establish a new entry, extending from the location of the
-- pragma to the end of the current source file. This ending point will
-- be adjusted by a subsequent pragma Warnings (On).
else
Warnings.Increment_Last;
......@@ -1170,8 +1171,8 @@ package body Erroutc is
procedure Set_Warnings_Mode_On (Loc : Source_Ptr) is
begin
-- Don't bother with entries from instantiation copies, since we
-- will already have a copy in the template, which is what matters
-- Don't bother with entries from instantiation copies, since we will
-- already have a copy in the template, which is what matters.
if Instantiation (Get_Source_File_Index (Loc)) /= No_Location then
return;
......
gcc/ada/erroutc.ads
......@@ -445,7 +445,8 @@ package Erroutc is
procedure Set_Specific_Warning_Off
(Loc : Source_Ptr;
Msg : String;
Config : Boolean);
Config : Boolean;
Used : Boolean := False);
-- This is called in response to the two argument form of pragma Warnings
-- where the first argument is OFF, and the second argument is a string
-- which identifies a specific warning to be suppressed. The first argument
......@@ -453,6 +454,8 @@ package Erroutc is
-- string from the pragma. Loc is the location of the pragma (which is the
-- start of the range to suppress). Config is True for the configuration
-- pragma case (where there is no requirement for a matching OFF pragma).
-- Used is set True to disable the check that the warning actually has
-- has the effect of suppressing a warning.
procedure Set_Specific_Warning_On
(Loc : Source_Ptr;
......
gcc/ada/sem_prag.adb
......@@ -14528,7 +14528,7 @@ package body Sem_Prag is
end;
end if;
-- Two or more arguments (must be two)
-- Two or more arguments (must be two)
else
Check_Arg_Is_One_Of (Arg1, Name_On, Name_Off);
......@@ -14547,8 +14547,7 @@ package body Sem_Prag is
-- the formal may be wrapped in a conversion if the
-- actual is a conversion. Retrieve the real entity name.
if (In_Instance_Body
or else In_Inlined_Body)
if (In_Instance_Body or else In_Inlined_Body)
and then Nkind (E_Id) = N_Unchecked_Type_Conversion
then
E_Id := Expression (E_Id);
......@@ -14612,10 +14611,21 @@ package body Sem_Prag is
-- In any other case, an error will be signalled (ON
-- with no matching OFF).
-- Note: We set Used if we are inside a generic to
-- disable the test that the non-config case actually
-- cancels a warning. That's because we can't be sure
-- there isn't an instantiation in some other unit
-- where a warning is suppressed.
-- We could do a little better here by checking if the
-- generic unit we are inside is public, but for now
-- we don't bother with that refinement.
if Chars (Argx) = Name_Off then
Set_Specific_Warning_Off
(Loc, Name_Buffer (1 .. Name_Len),
Config => Is_Configuration_Pragma);
Config => Is_Configuration_Pragma,
Used => Inside_A_Generic or else In_Instance);
elsif Chars (Argx) = Name_On then
Set_Specific_Warning_On
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment