diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 10 | ||||
| -rw-r--r-- | gcc/ada/exp_attr.adb | 34 | ||||
| -rw-r--r-- | gcc/ada/sem_ch4.adb | 35 |
3 files changed, 60 insertions, 19 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 5eff9e2..f1754d8 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,13 @@ +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> * opt.ads: Add missing GNAT markers in comments. diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 79560ae..5413581 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -362,16 +362,18 @@ package body Exp_Attr is --------------------------------- function Build_Disp_Get_Task_Id_Call (Actual : Node_Id) return Node_Id is - Typ : constant Entity_Id := Etype (Actual); - Id : constant Node_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)); + Loc : constant Source_Ptr := Sloc (Actual); + Typ : constant Entity_Id := Etype (Actual); + Subp : constant Entity_Id := Find_Prim_Op (Typ, Name_uDisp_Get_Task_Id); + 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; -------------------------- @@ -2501,13 +2503,13 @@ package body Exp_Attr is then Rewrite (N, Make_Function_Call (Loc, - Name => + Name => New_Occurrence_Of (RTE (RE_Callable), Loc), Parameter_Associations => New_List ( Make_Unchecked_Type_Conversion (Loc, Subtype_Mark => New_Occurrence_Of (RTE (RO_ST_Task_Id), Loc), - Expression => Build_Disp_Get_Task_Id_Call (Pref))))); + Expression => Build_Disp_Get_Task_Id_Call (Pref))))); else Rewrite (N, Build_Call_With_Task (Pref, RTE (RE_Callable))); @@ -3591,9 +3593,9 @@ package body Exp_Attr is and then Is_Interface (Ptyp) and then Is_Task_Interface (Ptyp) then - Rewrite - (N, Unchecked_Convert_To - (Id_Kind, Build_Disp_Get_Task_Id_Call (Pref))); + Rewrite (N, + Unchecked_Convert_To + (Id_Kind, Build_Disp_Get_Task_Id_Call (Pref))); else Rewrite (N, @@ -6282,13 +6284,13 @@ package body Exp_Attr is then Rewrite (N, Make_Function_Call (Loc, - Name => + Name => New_Occurrence_Of (RTE (RE_Terminated), Loc), Parameter_Associations => New_List ( Make_Unchecked_Type_Conversion (Loc, Subtype_Mark => New_Occurrence_Of (RTE (RO_ST_Task_Id), Loc), - Expression => Build_Disp_Get_Task_Id_Call (Pref))))); + Expression => Build_Disp_Get_Task_Id_Call (Pref))))); elsif Restricted_Profile then Rewrite (N, diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 4f2c1fd..12f930d 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -4311,6 +4311,7 @@ package body Sem_Ch4 is Act_Decl : Node_Id; Comp : Entity_Id; Has_Candidate : Boolean := False; + Hidden_Comp : Entity_Id; In_Scope : Boolean; Is_Private_Op : Boolean; Parent_N : Node_Id; @@ -4850,6 +4851,7 @@ package body Sem_Ch4 is -- can only be a direct name or an expanded name. Set_Etype (Sel, Any_Type); + Hidden_Comp := Empty; In_Scope := In_Open_Scopes (Prefix_Type); Is_Private_Op := False; @@ -4900,6 +4902,10 @@ package body Sem_Ch4 is Has_Candidate := True; else + if Ekind (Comp) = E_Component then + Hidden_Comp := Comp; + end if; + goto Next_Comp; end if; @@ -4921,6 +4927,20 @@ package body Sem_Ch4 is end if; <<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); exit when not In_Scope and then @@ -4968,11 +4988,20 @@ package body Sem_Ch4 is elsif In_Scope and then Is_Object_Reference (Original_Node (Prefix (N))) + and then Comes_From_Source (N) and then Is_Private_Op then - Error_Msg_NE - ("invalid reference to private operation of some object of " - & "type &", N, Type_To_Use); + 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 + ("invalid reference to private operation of some object of " + & "type &", N, Type_To_Use); + end if; + Set_Entity (Sel, Any_Id); Set_Etype (Sel, Any_Type); return; |