[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:
parent
488f9623ba
commit
26f36fc9f6
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user