+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
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;
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
procedure Set_Specific_Warning_Off
(Loc : Source_Ptr;
Msg : String;
- Config : Boolean)
+ Config : Boolean;
+ Used : Boolean := False)
is
begin
Specific_Warnings.Append
Msg => new String'(Msg),
Stop => Source_Last (Current_Source_File),
Open => True,
- Used => False,
+ Used => Used,
Config => Config));
end Set_Specific_Warning_Off;
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
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;
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;
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
-- 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;
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);
-- 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);
-- 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
projects / gcc.git / commitdiff