[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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 5eff9e254a99f5c866b080e572c15bd136f56370..f1754d8723bd399fe75b93eeeb68eb6b9a614281 100644 (file)
--- 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 79560ae86c0a9ff4aab7c2715548d43a5b5a5cf7..5413581002f0a21bed798c0540f1c2493794d9ef 100644 (file)
--- 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 4f2c1fd6c5505435000fcff58289111db64b9d71..12f930df6989c89e8a0d366967abe036359c9229 100644 (file)
--- 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;