[Ada] Consolidate handling of implicit dereferences into semantic analysis

2020-06-11  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* checks.adb (Build_Discriminant_Checks): Build an explicit
	dereference when the type is an access type.
	* exp_atag.adb (Build_CW_Membership): Add explicit dereferences.
	(Build_Get_Access_Level): Likewise.
	(Build_Get_Alignment): Likewise.
	(Build_Inherit_Prims): Likewise.
	(Build_Get_Transportable): Likewise.
	(Build_Set_Size_Function): Likewise.
	* exp_ch3.adb (Build_Offset_To_Top_Function): Likewise.
	* exp_ch4.adb (Expand_Allocator_Expression): Likewise.
	(Expand_N_Indexed_Component ): Remove code dealing with implicit
	dereferences.
	(Expand_N_Selected_Component): Likewise.
	(Expand_N_Slice): Likewise.
	* exp_ch9.adb (Add_Formal_Renamings): Add explicit dereference.
	(Expand_Accept_Declarations): Likewise.
	(Build_Simple_Entry_Call): Remove code dealing with implicit
	dereferences.
	(Expand_N_Requeue_Statement): Likewise.
	* exp_disp.adb (Expand_Dispatching_Call): Build an explicit
	dereference when the controlling type is an access type.
	* exp_spark.adb (Expand_SPARK_N_Selected_Component): Delete.
	(Expand_SPARK_N_Slice_Or_Indexed_Component): Likewise.
	(Expand_SPARK): Do not call them.
	* sem_ch4.adb (Process_Implicit_Dereference_Prefix): Delete.
	(Process_Indexed_Component): Call Implicitly_Designated_Type
	to get the designated type for an implicit dereference.
	(Analyze_Overloaded_Selected_Component): Do not insert an
	explicit dereference here.
	(Analyze_Selected_Component): Likewise.
	(Analyze_Slice): Call Implicitly_Designated_Type to get the
	designated type for an implicit dereference.
	* sem_ch8.adb (Has_Components): New predicate extracted from...
	(Is_Appropriate_For_Record): ...this.  Delete.
	(Is_Appropriate_For_Entry_Prefix): Likewise.
	(Analyze_Renamed_Entry): Deal with implicit dereferences.
	(Find_Selected_Component): Do not insert an explicit dereference
	here.  Call Implicitly_Designated_Type to get the designated type
	for an implicit dereference.  Call Has_Components, Is_Task_Type
	and Is_Protected_Type directly.  Adjust test for error.
	* sem_res.adb (Resolve_Implicit_Dereference): New procedure.
	(Resolve_Call): Call Resolve_Indexed_Component last.
	(Resolve_Entry): Call Resolve_Implicit_Dereference on the prefix.
	(Resolve_Indexed_Component): Call Implicitly_Designated_Type to
	get the designated type for an implicit dereference and
	Resolve_Implicit_Dereference on the prefix at the end.
	(Resolve_Selected_Component): Likewise.
	(Resolve_Slice): Likewise.  Do not apply access checks here.
	* sem_util.ads (Implicitly_Designated_Type): Declare.
	* sem_util.adb (Copy_And_Maybe_Dereference): Simplify.
	(Implicitly_Designated_Type): New function.
	(Object_Access_Level): Fix typo.
	* sem_warn.adb (Check_Unset_Reference): Test Comes_From_Source
	on the original node.

1 files changed, 10 insertions, 101 deletions

diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 3d3e2c7..a710ba2 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -171,6 +171,7 @@ package body Sem_Ch4 is
    --  being called. The caller will have verified that the object is legal
    --  for the call. If the remaining parameters match, the first parameter
    --  will rewritten as a dereference if needed, prior to completing analysis.
+
    procedure Check_Misspelled_Selector
      (Prefix : Entity_Id;
       Sel    : Node_Id);
@@ -276,20 +277,6 @@ package body Sem_Ch4 is
    --  type is not directly visible. The routine uses this type to emit a more
    --  informative message.
 
-   function Process_Implicit_Dereference_Prefix
-     (E : Entity_Id;
-      P : Node_Id) return Entity_Id;
-   --  Called when P is the prefix of an implicit dereference, denoting an
-   --  object E. The function returns the designated type of the prefix, taking
-   --  into account that the designated type of an anonymous access type may be
-   --  a limited view, when the nonlimited view is visible.
-   --
-   --  If in semantics only mode (-gnatc or generic), the function also records
-   --  that the prefix is a reference to E, if any. Normally, such a reference
-   --  is generated only when the implicit dereference is expanded into an
-   --  explicit one, but for consistency we must generate the reference when
-   --  expansion is disabled as well.
-
    procedure Remove_Abstract_Operations (N : Node_Id);
    --  Ada 2005: implementation of AI-310. An abstract non-dispatching
    --  operation is not a candidate interpretation.
@@ -2351,7 +2338,10 @@ package body Sem_Ch4 is
 
       procedure Process_Function_Call;
       --  Prefix in indexed component form is an overloadable entity, so the
-      --  node is a function call. Reformat it as such.
+      --  node is very likely a function call; reformat it as such. The only
+      --  exception is a call to a parameterless function that returns an
+      --  array type, or an access type thereof, in which case this will be
+      --  undone later by Resolve_Call or Resolve_Entry_Call.
 
       procedure Process_Indexed_Component;
       --  Prefix in indexed component form is actually an indexed component.
@@ -2462,7 +2452,7 @@ package body Sem_Ch4 is
             if Is_Access_Type (Array_Type) then
                Error_Msg_NW
                  (Warn_On_Dereference, "?d?implicit dereference", N);
-               Array_Type := Process_Implicit_Dereference_Prefix (Pent, P);
+               Array_Type := Implicitly_Designated_Type (Array_Type);
             end if;
 
             if Is_Array_Type (Array_Type) then
@@ -3898,18 +3888,6 @@ package body Sem_Ch4 is
                   Set_Etype (Sel, Etype (Comp));
                   Set_Etype (N,   Etype (Comp));
                   Set_Etype (Nam, It.Typ);
-
-                  --  For access type case, introduce explicit dereference for
-                  --  more uniform treatment of entry calls. Do this only once
-                  --  if several interpretations yield an access type.
-
-                  if Is_Access_Type (Etype (Nam))
-                    and then Nkind (Nam) /= N_Explicit_Dereference
-                  then
-                     Insert_Explicit_Dereference (Nam);
-                     Error_Msg_NW
-                       (Warn_On_Dereference, "?d?implicit dereference", N);
-                  end if;
                end if;
 
                Next_Entity (Comp);
@@ -4379,7 +4357,6 @@ package body Sem_Ch4 is
       In_Scope      : Boolean;
       Is_Private_Op : Boolean;
       Parent_N      : Node_Id;
-      Pent          : Entity_Id := Empty;
       Prefix_Type   : Entity_Id;
 
       Type_To_Use : Entity_Id;
@@ -4408,7 +4385,8 @@ package body Sem_Ch4 is
       --  indexed component rather than a function call.
 
       function Has_Dereference (Nod : Node_Id) return Boolean;
-      --  Check whether prefix includes a dereference at any level.
+      --  Check whether prefix includes a dereference, explicit or implicit,
+      --  at any recursive level.
 
       --------------------------------
       -- Find_Component_In_Instance --
@@ -4520,10 +4498,6 @@ package body Sem_Ch4 is
          if Nkind (Nod) = N_Explicit_Dereference then
             return True;
 
-         --  When expansion is disabled an explicit dereference may not have
-         --  been inserted, but if this is an access type the indirection makes
-         --  the call safe.
-
          elsif Is_Access_Type (Etype (Nod)) then
             return True;
 
@@ -4576,16 +4550,7 @@ package body Sem_Ch4 is
 
          else
             Error_Msg_NW (Warn_On_Dereference, "?d?implicit dereference", N);
-
-            if Is_Entity_Name (Name) then
-               Pent := Entity (Name);
-            elsif Nkind (Name) = N_Selected_Component
-              and then Is_Entity_Name (Selector_Name (Name))
-            then
-               Pent := Entity (Selector_Name (Name));
-            end if;
-
-            Prefix_Type := Process_Implicit_Dereference_Prefix (Pent, Name);
+            Prefix_Type := Implicitly_Designated_Type (Prefix_Type);
          end if;
 
       --  If we have an explicit dereference of a remote access-to-class-wide
@@ -4673,11 +4638,6 @@ package body Sem_Ch4 is
          Set_Etype (N, Etype (Comp));
          Check_Implicit_Dereference (N, Etype (Comp));
 
-         if Is_Access_Type (Etype (Name)) then
-            Insert_Explicit_Dereference (Name);
-            Error_Msg_NW (Warn_On_Dereference, "?d?implicit dereference", N);
-         end if;
-
       elsif Is_Record_Type (Prefix_Type) then
 
          --  Find component with given name. In an instance, if the node is
@@ -4978,15 +4938,6 @@ package body Sem_Ch4 is
                if Ekind (Comp) = E_Discriminant then
                   Set_Original_Discriminant (Sel, Comp);
                end if;
-
-               --  For access type case, introduce explicit dereference for
-               --  more uniform treatment of entry calls.
-
-               if Is_Access_Type (Etype (Name)) then
-                  Insert_Explicit_Dereference (Name);
-                  Error_Msg_NW
-                    (Warn_On_Dereference, "?d?implicit dereference", N);
-               end if;
             end if;
 
             <<Next_Comp>>
@@ -5455,8 +5406,8 @@ package body Sem_Ch4 is
          Set_Etype (N, Any_Type);
 
          if Is_Access_Type (Array_Type) then
-            Array_Type := Designated_Type (Array_Type);
             Error_Msg_NW (Warn_On_Dereference, "?d?implicit dereference", N);
+            Array_Type := Implicitly_Designated_Type (Array_Type);
          end if;
 
          if not Is_Array_Type (Array_Type) then
@@ -7401,48 +7352,6 @@ package body Sem_Ch4 is
       end if;
    end Operator_Check;
 
-   -----------------------------------------
-   -- Process_Implicit_Dereference_Prefix --
-   -----------------------------------------
-
-   function Process_Implicit_Dereference_Prefix
-     (E : Entity_Id;
-      P : Entity_Id) return Entity_Id
-   is
-      Ref : Node_Id;
-      Typ : constant Entity_Id := Designated_Type (Etype (P));
-
-   begin
-      if Present (E)
-        and then (Operating_Mode = Check_Semantics or else not Expander_Active)
-      then
-         --  We create a dummy reference to E to ensure that the reference is
-         --  not considered as part of an assignment (an implicit dereference
-         --  can never assign to its prefix). The Comes_From_Source attribute
-         --  needs to be propagated for accurate warnings.
-
-         Ref := New_Occurrence_Of (E, Sloc (P));
-         Set_Comes_From_Source (Ref, Comes_From_Source (P));
-         Generate_Reference (E, Ref);
-      end if;
-
-      --  An implicit dereference is a legal occurrence of an incomplete type
-      --  imported through a limited_with clause, if the full view is visible.
-
-      if From_Limited_With (Typ)
-        and then not From_Limited_With (Scope (Typ))
-        and then
-          (Is_Immediately_Visible (Scope (Typ))
-            or else
-              (Is_Child_Unit (Scope (Typ))
-                and then Is_Visible_Lib_Unit (Scope (Typ))))
-      then
-         return Available_View (Typ);
-      else
-         return Typ;
-      end if;
-   end Process_Implicit_Dereference_Prefix;
-
    --------------------------------
    -- Remove_Abstract_Operations --
    --------------------------------