Commit c0e938d0 by Arnaud Charlet

[multiple changes]

2017-05-02  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_attr.adb: Minor reformatting.

2017-05-02  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch4.adb (Analyze_Selected_Component): Improve error
	detection for illegal references to private components or
	operations of a protected type in the body of the type.

From-SVN: r247469
parent 99bba92c
2017-05-02 Hristian Kirtchev <kirtchev@adacore.com>
* exp_attr.adb: Minor reformatting.
2017-05-02 Ed Schonberg <schonberg@adacore.com>
* sem_ch4.adb (Analyze_Selected_Component): Improve error
detection for illegal references to private components or
operations of a protected type in the body of the type.
2017-05-02 Eric Botcazou <ebotcazou@adacore.com> 2017-05-02 Eric Botcazou <ebotcazou@adacore.com>
* opt.ads: Add missing GNAT markers in comments. * opt.ads: Add missing GNAT markers in comments.
......
...@@ -362,16 +362,18 @@ package body Exp_Attr is ...@@ -362,16 +362,18 @@ package body Exp_Attr is
--------------------------------- ---------------------------------
function Build_Disp_Get_Task_Id_Call (Actual : Node_Id) return Node_Id is function Build_Disp_Get_Task_Id_Call (Actual : Node_Id) return Node_Id is
Loc : constant Source_Ptr := Sloc (Actual);
Typ : constant Entity_Id := Etype (Actual); Typ : constant Entity_Id := Etype (Actual);
Id : constant Node_Id := Subp : constant Entity_Id := Find_Prim_Op (Typ, Name_uDisp_Get_Task_Id);
New_Occurrence_Of
(Find_Prim_Op (Typ, Name_uDisp_Get_Task_Id), Sloc (Actual));
Result : constant Node_Id :=
Make_Function_Call (Sloc (Actual),
Name => Id,
Parameter_Associations => New_List (Actual));
begin begin
return Result; -- Generate:
-- _Disp_Get_Task_Id (Actual)
return
Make_Function_Call (Loc,
Name => New_Occurrence_Of (Subp, Loc),
Parameter_Associations => New_List (Actual));
end Build_Disp_Get_Task_Id_Call; end Build_Disp_Get_Task_Id_Call;
-------------------------- --------------------------
...@@ -3591,8 +3593,8 @@ package body Exp_Attr is ...@@ -3591,8 +3593,8 @@ package body Exp_Attr is
and then Is_Interface (Ptyp) and then Is_Interface (Ptyp)
and then Is_Task_Interface (Ptyp) and then Is_Task_Interface (Ptyp)
then then
Rewrite Rewrite (N,
(N, Unchecked_Convert_To Unchecked_Convert_To
(Id_Kind, Build_Disp_Get_Task_Id_Call (Pref))); (Id_Kind, Build_Disp_Get_Task_Id_Call (Pref)));
else else
......
...@@ -4311,6 +4311,7 @@ package body Sem_Ch4 is ...@@ -4311,6 +4311,7 @@ package body Sem_Ch4 is
Act_Decl : Node_Id; Act_Decl : Node_Id;
Comp : Entity_Id; Comp : Entity_Id;
Has_Candidate : Boolean := False; Has_Candidate : Boolean := False;
Hidden_Comp : Entity_Id;
In_Scope : Boolean; In_Scope : Boolean;
Is_Private_Op : Boolean; Is_Private_Op : Boolean;
Parent_N : Node_Id; Parent_N : Node_Id;
...@@ -4850,6 +4851,7 @@ package body Sem_Ch4 is ...@@ -4850,6 +4851,7 @@ package body Sem_Ch4 is
-- can only be a direct name or an expanded name. -- can only be a direct name or an expanded name.
Set_Etype (Sel, Any_Type); Set_Etype (Sel, Any_Type);
Hidden_Comp := Empty;
In_Scope := In_Open_Scopes (Prefix_Type); In_Scope := In_Open_Scopes (Prefix_Type);
Is_Private_Op := False; Is_Private_Op := False;
...@@ -4900,6 +4902,10 @@ package body Sem_Ch4 is ...@@ -4900,6 +4902,10 @@ package body Sem_Ch4 is
Has_Candidate := True; Has_Candidate := True;
else else
if Ekind (Comp) = E_Component then
Hidden_Comp := Comp;
end if;
goto Next_Comp; goto Next_Comp;
end if; end if;
...@@ -4921,6 +4927,20 @@ package body Sem_Ch4 is ...@@ -4921,6 +4927,20 @@ package body Sem_Ch4 is
end if; end if;
<<Next_Comp>> <<Next_Comp>>
if Comp = First_Private_Entity (Type_To_Use) then
if Etype (Sel) /= Any_Type then
-- We have a candiate.
exit;
else
-- Indicate that subsequent operations are private,
-- for better error reporting.
Is_Private_Op := True;
end if;
end if;
Next_Entity (Comp); Next_Entity (Comp);
exit when not In_Scope exit when not In_Scope
and then and then
...@@ -4968,11 +4988,20 @@ package body Sem_Ch4 is ...@@ -4968,11 +4988,20 @@ package body Sem_Ch4 is
elsif In_Scope elsif In_Scope
and then Is_Object_Reference (Original_Node (Prefix (N))) and then Is_Object_Reference (Original_Node (Prefix (N)))
and then Comes_From_Source (N)
and then Is_Private_Op and then Is_Private_Op
then then
if Present (Hidden_Comp) then
Error_Msg_NE
("invalid reference to private component of object "
& "of type &", N, Type_To_Use);
else
Error_Msg_NE Error_Msg_NE
("invalid reference to private operation of some object of " ("invalid reference to private operation of some object of "
& "type &", N, Type_To_Use); & "type &", N, Type_To_Use);
end if;
Set_Entity (Sel, Any_Id); Set_Entity (Sel, Any_Id);
Set_Etype (Sel, Any_Type); Set_Etype (Sel, Any_Type);
return; return;
......
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