[multiple changes]

2015-03-04  Ed Schonberg  <schonberg@adacore.com>

	* sem_warn.adb (Check_References): When checking for an unused
	in-out parameter of a class- wide type, use its type to determine
	whether it is private, in order to avoid a spurious warning when
	subprogram spec and body are in different units.

2015-03-04  Yannick Moy  <moy@adacore.com>

	* sem_attr.adb: Improve warning messages.

From-SVN: r221178
This commit is contained in:
Arnaud Charlet 2015-03-04 10:58:41 +01:00
parent 488f9623ba
commit 26f36fc9f6
3 changed files with 44 additions and 14 deletions

View File

@ -1,3 +1,14 @@
2015-03-04 Ed Schonberg <schonberg@adacore.com>
* sem_warn.adb (Check_References): When checking for an unused
in-out parameter of a class- wide type, use its type to determine
whether it is private, in order to avoid a spurious warning when
subprogram spec and body are in different units.
2015-03-04 Yannick Moy <moy@adacore.com>
* sem_attr.adb: Improve warning messages.
2015-03-04 Robert Dewar <dewar@adacore.com> 2015-03-04 Robert Dewar <dewar@adacore.com>
* exp_ch6.adb (Expand_N_Subprogram_Body): Avoid trying to unnest * exp_ch6.adb (Expand_N_Subprogram_Body): Avoid trying to unnest

View File

@ -1103,6 +1103,10 @@ package body Sem_Attr is
-- Subsidiary to Check_Placemenet_In_XXX. Determine whether arbitrary -- Subsidiary to Check_Placemenet_In_XXX. Determine whether arbitrary
-- node Nod is within enclosing node Encl_Nod. -- node Nod is within enclosing node Encl_Nod.
procedure Placement_Error;
-- Emit a general error when the attributes does not appear in a
-- postcondition-like aspect or pragma.
------------------------------ ------------------------------
-- Check_Placement_In_Check -- -- Check_Placement_In_Check --
------------------------------ ------------------------------
@ -1124,17 +1128,7 @@ package body Sem_Attr is
-- Otherwise the placement of the attribute is illegal -- Otherwise the placement of the attribute is illegal
else else
if Aname = Name_Old then Placement_Error;
Error_Attr
("attribute % can only appear in postcondition", P);
-- Specialize the error message for attribute 'Result
else
Error_Attr
("attribute % can only appear in postcondition of "
& "function", P);
end if;
end if; end if;
end Check_Placement_In_Check; end Check_Placement_In_Check;
@ -1236,6 +1230,24 @@ package body Sem_Attr is
return False; return False;
end Is_Within; end Is_Within;
---------------------
-- Placement_Error --
---------------------
procedure Placement_Error is
begin
if Aname = Name_Old then
Error_Attr ("attribute % can only appear in postcondition", P);
-- Specialize the error message for attribute 'Result
else
Error_Attr
("attribute % can only appear in postcondition of function",
P);
end if;
end Placement_Error;
-- Local variables -- Local variables
Prag : Node_Id; Prag : Node_Id;
@ -1294,14 +1306,14 @@ package body Sem_Attr is
Check_Placement_In_Test_Case (Prag); Check_Placement_In_Test_Case (Prag);
else else
Error_Attr ("attribute % can only appear in postcondition", P); Placement_Error;
return; return;
end if; end if;
-- Otherwise the placement of the attribute is illegal -- Otherwise the placement of the attribute is illegal
else else
Error_Attr ("attribute % can only appear in postcondition", P); Placement_Error;
return; return;
end if; end if;
@ -4797,7 +4809,7 @@ package body Sem_Attr is
if Is_Constant_Object (Pref_Id) then if Is_Constant_Object (Pref_Id) then
Error_Msg_Name_1 := Name_Old; Error_Msg_Name_1 := Name_Old;
Error_Msg_N Error_Msg_N
("??atribute % applied to constant has no effect", P); ("??attribute % applied to constant has no effect", P);
end if; end if;
-- Otherwise the prefix is not a simple name -- Otherwise the prefix is not a simple name

View File

@ -1080,6 +1080,13 @@ package body Sem_Warn is
(Ekind_In (E1, E_Out_Parameter, E_In_Out_Parameter) (Ekind_In (E1, E_Out_Parameter, E_In_Out_Parameter)
and then not Is_Protected_Type (Current_Scope)) and then not Is_Protected_Type (Current_Scope))
then then
-- If the formal has a class-wide type, retrieve its type
-- because checks below depend on its private nature.
if Is_Class_Wide_Type (E1T) then
E1T := Etype (E1T);
end if;
-- Case of an unassigned variable -- Case of an unassigned variable
-- First gather any Unset_Reference indication for E1. In the -- First gather any Unset_Reference indication for E1. In the