[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.

13 files changed, 174 insertions, 366 deletions

diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index ae62a9d..641a5b2 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -3964,6 +3964,15 @@ package body Checks is
                Duplicate_Subexpr_No_Checks
                  (Aggregate_Discriminant_Val (Disc_Ent));
 
+         elsif Is_Access_Type (Etype (N)) then
+            Dref :=
+              Make_Selected_Component (Loc,
+                Prefix        =>
+                  Make_Explicit_Dereference (Loc,
+                    Duplicate_Subexpr_No_Checks (N, Name_Req => True)),
+                Selector_Name => Make_Identifier (Loc, Chars (Disc_Ent)));
+
+            Set_Is_In_Discriminant_Check (Dref);
          else
             Dref :=
               Make_Selected_Component (Loc,
diff --git a/gcc/ada/exp_atag.adb b/gcc/ada/exp_atag.adb
index b7bbc20..bdd3f05 100644
--- a/gcc/ada/exp_atag.adb
+++ b/gcc/ada/exp_atag.adb
@@ -229,14 +229,18 @@ package body Exp_Atag is
             Make_Op_Subtract (Loc,
               Left_Opnd =>
                 Make_Selected_Component (Loc,
-                  Prefix        => New_Occurrence_Of (Obj_TSD, Loc),
+                  Prefix        =>
+                    Make_Explicit_Dereference (Loc,
+                      New_Occurrence_Of (Obj_TSD, Loc)),
                   Selector_Name =>
                      New_Occurrence_Of
                        (RTE_Record_Component (RE_Idepth), Loc)),
 
                Right_Opnd =>
                  Make_Selected_Component (Loc,
-                   Prefix        => New_Occurrence_Of (Typ_TSD, Loc),
+                   Prefix        =>
+                     Make_Explicit_Dereference (Loc,
+                       New_Occurrence_Of (Typ_TSD, Loc)),
                    Selector_Name =>
                      New_Occurrence_Of
                        (RTE_Record_Component (RE_Idepth), Loc)))),
@@ -255,7 +259,9 @@ package body Exp_Atag is
                 Make_Indexed_Component (Loc,
                   Prefix      =>
                     Make_Selected_Component (Loc,
-                      Prefix        => New_Occurrence_Of (Obj_TSD, Loc),
+                      Prefix        =>
+                        Make_Explicit_Dereference (Loc,
+                          New_Occurrence_Of (Obj_TSD, Loc)),
                       Selector_Name =>
                         New_Occurrence_Of
                           (RTE_Record_Component (RE_Tags_Table), Loc)),
@@ -293,8 +299,9 @@ package body Exp_Atag is
       return
         Make_Selected_Component (Loc,
           Prefix =>
-            Build_TSD (Loc,
-              Unchecked_Convert_To (RTE (RE_Address), Tag_Node)),
+            Make_Explicit_Dereference (Loc,
+              Build_TSD (Loc,
+                Unchecked_Convert_To (RTE (RE_Address), Tag_Node))),
           Selector_Name =>
             New_Occurrence_Of
               (RTE_Record_Component (RE_Access_Level), Loc));
@@ -311,8 +318,10 @@ package body Exp_Atag is
    begin
       return
         Make_Selected_Component (Loc,
-          Prefix        =>
-            Build_TSD (Loc, Unchecked_Convert_To (RTE (RE_Address), Tag_Node)),
+          Prefix =>
+            Make_Explicit_Dereference (Loc,
+              Build_TSD (Loc,
+                Unchecked_Convert_To (RTE (RE_Address), Tag_Node))),
           Selector_Name =>
             New_Occurrence_Of (RTE_Record_Component (RE_Alignment), Loc));
    end Build_Get_Alignment;
@@ -639,7 +648,8 @@ package body Exp_Atag is
                  Prefix =>
                    Make_Selected_Component (Loc,
                      Prefix =>
-                       Build_DT (Loc, New_Tag_Node),
+                       Make_Explicit_Dereference (Loc,
+                         Build_DT (Loc, New_Tag_Node)),
                      Selector_Name =>
                        New_Occurrence_Of
                          (RTE_Record_Component (RE_Prims_Ptr), Loc)),
@@ -651,7 +661,8 @@ package body Exp_Atag is
                  Prefix =>
                    Make_Selected_Component (Loc,
                      Prefix =>
-                       Build_DT (Loc, Old_Tag_Node),
+                       Make_Explicit_Dereference (Loc,
+                         Build_DT (Loc, Old_Tag_Node)),
                      Selector_Name =>
                        New_Occurrence_Of
                          (RTE_Record_Component (RE_Prims_Ptr), Loc)),
@@ -728,8 +739,9 @@ package body Exp_Atag is
       return
         Make_Selected_Component (Loc,
           Prefix =>
-            Build_TSD (Loc,
-              Unchecked_Convert_To (RTE (RE_Address), Tag_Node)),
+            Make_Explicit_Dereference (Loc,
+              Build_TSD (Loc,
+                Unchecked_Convert_To (RTE (RE_Address), Tag_Node))),
           Selector_Name =>
             New_Occurrence_Of
               (RTE_Record_Component (RE_Transportable), Loc));
@@ -884,8 +896,9 @@ package body Exp_Atag is
           Name =>
             Make_Selected_Component (Loc,
               Prefix =>
-                Build_TSD (Loc,
-                  Unchecked_Convert_To (RTE (RE_Address), Tag_Node)),
+                Make_Explicit_Dereference (Loc,
+                  Build_TSD (Loc,
+                    Unchecked_Convert_To (RTE (RE_Address), Tag_Node))),
               Selector_Name =>
                 New_Occurrence_Of
                   (RTE_Record_Component (RE_Size_Func), Loc)),
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index f412deb..7d13cd6 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -2257,8 +2257,9 @@ package body Exp_Ch3 is
                           Prefix         =>
                             Make_Selected_Component (Loc,
                               Prefix        =>
-                                Unchecked_Convert_To (Acc_Type,
-                                  Make_Identifier (Loc, Name_uO)),
+                                Make_Explicit_Dereference (Loc,
+                                  Unchecked_Convert_To (Acc_Type,
+                                    Make_Identifier (Loc, Name_uO))),
                               Selector_Name =>
                                 New_Occurrence_Of (Iface_Comp, Loc)),
                           Attribute_Name => Name_Position))))));
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index d416c06..7a84215 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -1073,7 +1073,9 @@ package body Exp_Ch4 is
 
          elsif Is_Tagged_Type (T) and then not Is_Class_Wide_Type (T) then
             TagT := T;
-            TagR := New_Occurrence_Of (Temp, Loc);
+            TagR :=
+              Make_Explicit_Dereference (Loc,
+                Prefix => New_Occurrence_Of (Temp, Loc));
 
          elsif Is_Private_Type (T)
            and then Is_Tagged_Type (Underlying_Type (T))
@@ -6868,7 +6870,6 @@ package body Exp_Ch4 is
       Typ : constant Entity_Id  := Etype (N);
       P   : constant Node_Id    := Prefix (N);
       T   : constant Entity_Id  := Etype (P);
-      Atp : Entity_Id;
 
    begin
       --  A special optimization, if we have an indexed component that is
@@ -6917,20 +6918,6 @@ package body Exp_Ch4 is
          Make_Build_In_Place_Iface_Call_In_Anonymous_Context (P);
       end if;
 
-      --  If the prefix is an access type, then we unconditionally rewrite if
-      --  as an explicit dereference. This simplifies processing for several
-      --  cases, including packed array cases and certain cases in which checks
-      --  must be generated. We used to try to do this only when it was
-      --  necessary, but it cleans up the code to do it all the time.
-
-      if Is_Access_Type (T) then
-         Insert_Explicit_Dereference (P);
-         Analyze_And_Resolve (P, Designated_Type (T));
-         Atp := Designated_Type (T);
-      else
-         Atp := T;
-      end if;
-
       --  Generate index and validity checks
 
       Generate_Index_Checks (N);
@@ -6942,8 +6929,8 @@ package body Exp_Ch4 is
       --  If selecting from an array with atomic components, and atomic sync
       --  is not suppressed for this array type, set atomic sync flag.
 
-      if (Has_Atomic_Components (Atp)
-           and then not Atomic_Synchronization_Disabled (Atp))
+      if (Has_Atomic_Components (T)
+           and then not Atomic_Synchronization_Disabled (T))
         or else (Is_Atomic (Typ)
                   and then not Atomic_Synchronization_Disabled (Typ))
         or else (Is_Entity_Name (P)
@@ -10580,7 +10567,7 @@ package body Exp_Ch4 is
       Par   : constant Node_Id    := Parent (N);
       P     : constant Node_Id    := Prefix (N);
       S     : constant Node_Id    := Selector_Name (N);
-      Ptyp  : Entity_Id           := Underlying_Type (Etype (P));
+      Ptyp  : constant Entity_Id  := Underlying_Type (Etype (P));
       Disc  : Entity_Id;
       New_N : Node_Id;
       Dcon  : Elmt_Id;
@@ -10631,21 +10618,6 @@ package body Exp_Ch4 is
    --  Start of processing for Expand_N_Selected_Component
 
    begin
-      --  Insert explicit dereference if required
-
-      if Is_Access_Type (Ptyp) then
-
-         --  First set prefix type to proper access type, in case it currently
-         --  has a private (non-access) view of this type.
-
-         Set_Etype (P, Ptyp);
-
-         Insert_Explicit_Dereference (P);
-         Analyze_And_Resolve (P, Designated_Type (Ptyp));
-
-         Ptyp := Etype (P);
-      end if;
-
       --  Deal with discriminant check required
 
       if Do_Discriminant_Check (N) then
@@ -11018,23 +10990,10 @@ package body Exp_Ch4 is
       --  Local variables
 
       Pref     : constant Node_Id := Prefix (N);
-      Pref_Typ : Entity_Id        := Etype (Pref);
 
    --  Start of processing for Expand_N_Slice
 
    begin
-      --  Special handling for access types
-
-      if Is_Access_Type (Pref_Typ) then
-         Pref_Typ := Designated_Type (Pref_Typ);
-
-         Rewrite (Pref,
-           Make_Explicit_Dereference (Sloc (N),
-            Prefix => Relocate_Node (Pref)));
-
-         Analyze_And_Resolve (Pref, Pref_Typ);
-      end if;
-
       --  Ada 2005 (AI-318-02): If the prefix is a call to a build-in-place
       --  function, then additional actuals must be passed.
 
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index 49d3c1f..3d417ff 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -737,8 +737,9 @@ package body Exp_Ch9 is
          Renamed_Formal :=
            Make_Selected_Component (Loc,
              Prefix        =>
-               Unchecked_Convert_To (Entry_Parameters_Type (Ent),
-                 Make_Identifier (Loc, Chars (Ptr))),
+               Make_Explicit_Dereference (Loc,
+                 Unchecked_Convert_To (Entry_Parameters_Type (Ent),
+                   Make_Identifier (Loc, Chars (Ptr)))),
              Selector_Name => New_Occurrence_Of (Comp, Loc));
 
          Decl :=
@@ -4523,12 +4524,6 @@ package body Exp_Ch9 is
          Ent_Acc := Entry_Parameters_Type (Ent);
          Conctyp := Etype (Concval);
 
-         --  If prefix is an access type, dereference to obtain the task type
-
-         if Is_Access_Type (Conctyp) then
-            Conctyp := Designated_Type (Conctyp);
-         end if;
-
          --  Special case for protected subprogram calls
 
          if Is_Protected_Type (Conctyp)
@@ -6015,9 +6010,10 @@ package body Exp_Ch9 is
                   Renamed_Formal :=
                      Make_Selected_Component (Loc,
                        Prefix        =>
-                         Unchecked_Convert_To (
-                           Entry_Parameters_Type (Ent),
-                           New_Occurrence_Of (Ann, Loc)),
+                         Make_Explicit_Dereference (Loc,
+                           Unchecked_Convert_To (
+                             Entry_Parameters_Type (Ent),
+                             New_Occurrence_Of (Ann, Loc))),
                        Selector_Name =>
                          New_Occurrence_Of (Comp, Loc));
 
@@ -10533,16 +10529,6 @@ package body Exp_Ch9 is
       Extract_Entry (N, Concval, Ename, Index);
       Conc_Typ := Etype (Concval);
 
-      --  If the prefix is an access to class-wide type, dereference to get
-      --  object and entry type.
-
-      if Is_Access_Type (Conc_Typ) then
-         Conc_Typ := Designated_Type (Conc_Typ);
-         Rewrite (Concval,
-           Make_Explicit_Dereference (Loc, Relocate_Node (Concval)));
-         Analyze_And_Resolve (Concval, Conc_Typ);
-      end if;
-
       --  Examine the scope stack in order to find nearest enclosing protected
       --  or task type. This will constitute our invocation source.
 
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index b8cbd4a..b57ba58 100644
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -1114,6 +1114,14 @@ package body Exp_Disp is
       then
          Controlling_Tag := Duplicate_Subexpr (Ctrl_Arg);
 
+      elsif Is_Access_Type (Ctrl_Typ) then
+         Controlling_Tag :=
+           Make_Selected_Component (Loc,
+             Prefix        =>
+               Make_Explicit_Dereference (Loc,
+                 Duplicate_Subexpr_Move_Checks (Ctrl_Arg)),
+             Selector_Name => New_Occurrence_Of (DTC_Entity (Subp), Loc));
+
       else
          Controlling_Tag :=
            Make_Selected_Component (Loc,
diff --git a/gcc/ada/exp_spark.adb b/gcc/ada/exp_spark.adb
index 0e6c745..b8b303c 100644
--- a/gcc/ada/exp_spark.adb
+++ b/gcc/ada/exp_spark.adb
@@ -69,12 +69,6 @@ package body Exp_SPARK is
    procedure Expand_SPARK_N_Op_Ne (N : Node_Id);
    --  Rewrite operator /= based on operator = when defined explicitly
 
-   procedure Expand_SPARK_N_Selected_Component (N : Node_Id);
-   --  Insert explicit dereference if required
-
-   procedure Expand_SPARK_N_Slice_Or_Indexed_Component (N : Node_Id);
-   --  Insert explicit dereference if required
-
    ------------------
    -- Expand_SPARK --
    ------------------
@@ -136,14 +130,6 @@ package body Exp_SPARK is
                Expand_SPARK_N_Freeze_Type (Entity (N));
             end if;
 
-         when N_Indexed_Component
-            | N_Slice
-         =>
-            Expand_SPARK_N_Slice_Or_Indexed_Component (N);
-
-         when N_Selected_Component =>
-            Expand_SPARK_N_Selected_Component (N);
-
          --  In SPARK mode, no other constructs require expansion
 
          when others =>
@@ -481,40 +467,4 @@ package body Exp_SPARK is
       end if;
    end Expand_SPARK_Potential_Renaming;
 
-   ---------------------------------------
-   -- Expand_SPARK_N_Selected_Component --
-   ---------------------------------------
-
-   procedure Expand_SPARK_N_Selected_Component (N : Node_Id) is
-      Pref : constant Node_Id   := Prefix (N);
-      Typ  : constant Entity_Id := Underlying_Type (Etype (Pref));
-
-   begin
-      if Present (Typ) and then Is_Access_Type (Typ) then
-
-         --  First set prefix type to proper access type, in case it currently
-         --  has a private (non-access) view of this type.
-
-         Set_Etype (Pref, Typ);
-
-         Insert_Explicit_Dereference (Pref);
-         Analyze_And_Resolve (Pref, Designated_Type (Typ));
-      end if;
-   end Expand_SPARK_N_Selected_Component;
-
-   -----------------------------------------------
-   -- Expand_SPARK_N_Slice_Or_Indexed_Component --
-   -----------------------------------------------
-
-   procedure Expand_SPARK_N_Slice_Or_Indexed_Component (N : Node_Id) is
-      Pref : constant Node_Id   := Prefix (N);
-      Typ  : constant Entity_Id := Etype (Pref);
-
-   begin
-      if Is_Access_Type (Typ) then
-         Insert_Explicit_Dereference (Pref);
-         Analyze_And_Resolve (Pref, Designated_Type (Typ));
-      end if;
-   end Expand_SPARK_N_Slice_Or_Indexed_Component;
-
 end Exp_SPARK;
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 --
    --------------------------------
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 555862b..e8d5a90 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -501,6 +501,10 @@ package body Sem_Ch8 is
    --  Ada 2005 (AI-262): Determines if the current compilation unit has a
    --  private with on E.
 
+   function Has_Components (Typ : Entity_Id) return Boolean;
+   --  Determine if given type has components, i.e. is either a record type or
+   --  type or a type that has discriminants.
+
    function Has_Implicit_Operator (N : Node_Id) return Boolean;
    --  N is an expanded name whose selector is an operator name (e.g. P."+").
    --  declarative part contains an implicit declaration of an operator if it
@@ -515,14 +519,6 @@ package body Sem_Ch8 is
    --  specification are discarded and replaced with those of the renamed
    --  subprogram, which are then used to recheck the default values.
 
-   function Is_Appropriate_For_Entry_Prefix (T : Entity_Id) return Boolean;
-   --  True if it is of a task type, a protected type, or else an access to one
-   --  of these types.
-
-   function Is_Appropriate_For_Record (T : Entity_Id) return Boolean;
-   --  Prefix is appropriate for record if it is of a record type, or an access
-   --  to such.
-
    function Most_Descendant_Use_Clause
      (Clause1 : Entity_Id;
       Clause2 : Entity_Id) return Entity_Id;
@@ -1736,6 +1732,9 @@ package body Sem_Ch8 is
          --  The prefix can be an arbitrary expression that yields a task or
          --  protected object, so it must be resolved.
 
+         if Is_Access_Type (Etype (Prefix (Nam))) then
+            Insert_Explicit_Dereference (Prefix (Nam));
+         end if;
          Resolve (Prefix (Nam), Scope (Old_S));
       end if;
 
@@ -7333,23 +7332,6 @@ package body Sem_Ch8 is
                Set_Etype (N, C_Etype);
             end;
 
-            --  If this is the name of an entry or protected operation, and
-            --  the prefix is an access type, insert an explicit dereference,
-            --  so that entry calls are treated uniformly.
-
-            if Is_Access_Type (Etype (P))
-              and then Is_Concurrent_Type (Designated_Type (Etype (P)))
-            then
-               declare
-                  New_P : constant Node_Id :=
-                            Make_Explicit_Dereference (Sloc (P),
-                              Prefix => Relocate_Node (P));
-               begin
-                  Rewrite (P, New_P);
-                  Set_Etype (P, Designated_Type (Etype (Prefix (P))));
-               end;
-            end if;
-
          --  If the selected component appears within a default expression
          --  and it has an actual subtype, the preanalysis has not yet
          --  completed its analysis, because Insert_Actions is disabled in
@@ -7393,37 +7375,16 @@ package body Sem_Ch8 is
             Write_Entity_Info (P_Type, "      "); Write_Eol;
          end if;
 
-         --  The designated type may be a limited view with no components.
-         --  Check whether the non-limited view is available, because in some
-         --  cases this will not be set when installing the context. Rewrite
-         --  the node by introducing an explicit dereference at once, and
-         --  setting the type of the rewritten prefix to the non-limited view
-         --  of the original designated type.
+         --  If the prefix's type is an access type, get to the record type
 
          if Is_Access_Type (P_Type) then
-            declare
-               Desig_Typ : constant Entity_Id :=
-                             Directly_Designated_Type (P_Type);
-
-            begin
-               if Is_Incomplete_Type (Desig_Typ)
-                 and then From_Limited_With (Desig_Typ)
-                 and then Present (Non_Limited_View (Desig_Typ))
-               then
-                  Rewrite (P,
-                    Make_Explicit_Dereference (Sloc (P),
-                      Prefix => Relocate_Node (P)));
-
-                  Set_Etype (P, Get_Full_View (Non_Limited_View (Desig_Typ)));
-                  P_Type := Etype (P);
-               end if;
-            end;
+            P_Type := Implicitly_Designated_Type (P_Type);
          end if;
 
          --  First check for components of a record object (not the
          --  result of a call, which is handled below).
 
-         if Is_Appropriate_For_Record (P_Type)
+         if Has_Components (P_Type)
            and then not Is_Overloadable (P_Name)
            and then not Is_Type (P_Name)
          then
@@ -7437,7 +7398,7 @@ package body Sem_Ch8 is
 
          --  Reference to type name in predicate/invariant expression
 
-         elsif Is_Appropriate_For_Entry_Prefix (P_Type)
+         elsif (Is_Task_Type (P_Type) or else Is_Protected_Type (P_Type))
            and then not In_Open_Scopes (P_Name)
            and then (not Is_Concurrent_Type (Etype (P_Name))
                       or else not In_Open_Scopes (Etype (P_Name)))
@@ -7616,16 +7577,6 @@ package body Sem_Ch8 is
          else
             --  Format node as expanded name, to avoid cascaded errors
 
-            --  If the limited_with transformation was applied earlier, restore
-            --  source for proper error reporting.
-
-            if not Comes_From_Source (P)
-              and then Nkind (P) = N_Explicit_Dereference
-            then
-               Rewrite (P, Prefix (P));
-               P_Type := Etype (P);
-            end if;
-
             Change_Selected_Component_To_Expanded_Name (N);
             Set_Entity (N, Any_Id);
             Set_Etype  (N, Any_Type);
@@ -7687,8 +7638,8 @@ package body Sem_Ch8 is
 
                Error_Msg_N ("invalid prefix in selected component&", P);
 
-               if Is_Access_Type (P_Type)
-                 and then Ekind (Designated_Type (P_Type)) = E_Incomplete_Type
+               if Is_Incomplete_Type (P_Type)
+                 and then Is_Access_Type (Etype (P))
                then
                   Error_Msg_N
                     ("\dereference must not be of an incomplete type "
@@ -8042,6 +7993,20 @@ package body Sem_Ch8 is
       end if;
    end Find_Type;
 
+   --------------------
+   -- Has_Components --
+   --------------------
+
+   function Has_Components (Typ : Entity_Id) return Boolean is
+   begin
+      return Is_Record_Type (Typ)
+        or else (Is_Private_Type (Typ) and then Has_Discriminants (Typ))
+        or else (Is_Task_Type (Typ) and then Has_Discriminants (Typ))
+        or else (Is_Incomplete_Type (Typ)
+                  and then From_Limited_With (Typ)
+                  and then Is_Record_Type (Available_View (Typ)));
+   end Has_Components;
+
    ------------------------------------
    -- Has_Implicit_Character_Literal --
    ------------------------------------
@@ -8485,57 +8450,6 @@ package body Sem_Ch8 is
       end loop;
    end Install_Use_Clauses;
 
-   -------------------------------------
-   -- Is_Appropriate_For_Entry_Prefix --
-   -------------------------------------
-
-   function Is_Appropriate_For_Entry_Prefix (T : Entity_Id) return Boolean is
-      P_Type : Entity_Id := T;
-
-   begin
-      if Is_Access_Type (P_Type) then
-         P_Type := Designated_Type (P_Type);
-      end if;
-
-      return Is_Task_Type (P_Type) or else Is_Protected_Type (P_Type);
-   end Is_Appropriate_For_Entry_Prefix;
-
-   -------------------------------
-   -- Is_Appropriate_For_Record --
-   -------------------------------
-
-   function Is_Appropriate_For_Record (T : Entity_Id) return Boolean is
-
-      function Has_Components (T1 : Entity_Id) return Boolean;
-      --  Determine if given type has components (i.e. is either a record
-      --  type or a type that has discriminants).
-
-      --------------------
-      -- Has_Components --
-      --------------------
-
-      function Has_Components (T1 : Entity_Id) return Boolean is
-      begin
-         return Is_Record_Type (T1)
-           or else (Is_Private_Type (T1) and then Has_Discriminants (T1))
-           or else (Is_Task_Type (T1) and then Has_Discriminants (T1))
-           or else (Is_Incomplete_Type (T1)
-                     and then From_Limited_With (T1)
-                     and then Present (Non_Limited_View (T1))
-                     and then Is_Record_Type
-                                (Get_Full_View (Non_Limited_View (T1))));
-      end Has_Components;
-
-   --  Start of processing for Is_Appropriate_For_Record
-
-   begin
-      return
-        Present (T)
-          and then (Has_Components (T)
-                     or else (Is_Access_Type (T)
-                               and then Has_Components (Designated_Type (T))));
-   end Is_Appropriate_For_Record;
-
    ----------------------
    -- Mark_Use_Clauses --
    ----------------------
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index d172311..6c244db 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -226,6 +226,12 @@ package body Sem_Res is
    --  is the context type, which is used when the operation is a protected
    --  function with no arguments, and the return value is indexed.
 
+   procedure Resolve_Implicit_Dereference (P : Node_Id);
+   --  Called when P is the prefix of an indexed component, or of a selected
+   --  component, or of a slice. If P is of an access type, we unconditionally
+   --  rewrite it as an explicit dereference. This ensures that the expander
+   --  and the code generator have a fully explicit tree to work with.
+
    procedure Resolve_Intrinsic_Operator (N : Node_Id; Typ : Entity_Id);
    --  A call to a user-defined intrinsic operator is rewritten as a call to
    --  the corresponding predefined operator, with suitable conversions. Note
@@ -6369,7 +6375,6 @@ package body Sem_Res is
 
                   Set_Etype (Prefix (N), Ret_Type);
                   Set_Etype (N, Typ);
-                  Resolve_Indexed_Component (N, Typ);
 
                   if Legacy_Elaboration_Checks then
                      Check_Elab_Call (Prefix (N));
@@ -6381,6 +6386,8 @@ package body Sem_Res is
                   --  the ABE Processing phase.
 
                   Build_Call_Marker (Prefix (N));
+
+                  Resolve_Indexed_Component (N, Typ);
                end if;
             end if;
 
@@ -7783,10 +7790,12 @@ package body Sem_Res is
 
       if Nkind (Entry_Name) = N_Selected_Component then
          Resolve (Prefix (Entry_Name));
+         Resolve_Implicit_Dereference (Prefix (Entry_Name));
 
       else pragma Assert (Nkind (Entry_Name) = N_Indexed_Component);
          Nam := Entity (Selector_Name (Prefix (Entry_Name)));
          Resolve (Prefix (Prefix (Entry_Name)));
+         Resolve_Implicit_Dereference (Prefix (Prefix (Entry_Name)));
          Index := First (Expressions (Entry_Name));
          Resolve (Index, Entry_Index_Type (Nam));
 
@@ -8723,6 +8732,21 @@ package body Sem_Res is
       Analyze_Dimension (N);
    end Resolve_If_Expression;
 
+   ----------------------------------
+   -- Resolve_Implicit_Dereference --
+   ----------------------------------
+
+   procedure Resolve_Implicit_Dereference (P : Node_Id) is
+      Desig_Typ : Entity_Id;
+
+   begin
+      if Is_Access_Type (Etype (P)) then
+         Desig_Typ := Implicitly_Designated_Type (Etype (P));
+         Insert_Explicit_Dereference (P);
+         Analyze_And_Resolve (P, Desig_Typ);
+      end if;
+   end Resolve_Implicit_Dereference;
+
    -------------------------------
    -- Resolve_Indexed_Component --
    -------------------------------
@@ -8795,12 +8819,12 @@ package body Sem_Res is
       Resolve (Name, Array_Type);
       Array_Type := Get_Actual_Subtype_If_Available (Name);
 
-      --  If prefix is access type, dereference to get real array type.
-      --  Note: we do not apply an access check because the expander always
-      --  introduces an explicit dereference, and the check will happen there.
+      --  If the prefix's type is an access type, get to the real array type.
+      --  Note: we do not apply an access check because an explicit dereference
+      --  will be introduced later, and the check will happen there.
 
       if Is_Access_Type (Array_Type) then
-         Array_Type := Designated_Type (Array_Type);
+         Array_Type := Implicitly_Designated_Type (Array_Type);
       end if;
 
       --  If name was overloaded, set component type correctly now
@@ -8840,6 +8864,7 @@ package body Sem_Res is
          end loop;
       end if;
 
+      Resolve_Implicit_Dereference (Prefix (N));
       Analyze_Dimension (N);
 
       --  Do not generate the warning on suspicious index if we are analyzing
@@ -10402,12 +10427,12 @@ package body Sem_Res is
          Generate_Reference (Entity (S), S, 'r');
       end if;
 
-      --  If prefix is an access type, the node will be transformed into an
-      --  explicit dereference during expansion. The type of the node is the
-      --  designated type of that of the prefix.
+      --  If the prefix's type is an access type, get to the real record type.
+      --  Note: we do not apply an access check because an explicit dereference
+      --  will be introduced later, and the check will happen there.
 
       if Is_Access_Type (Etype (P)) then
-         T := Designated_Type (Etype (P));
+         T := Implicitly_Designated_Type (Etype (P));
          Check_Fully_Declared_Prefix (T, P);
 
       else
@@ -10482,6 +10507,7 @@ package body Sem_Res is
             Prefix (N));
       end if;
 
+      Resolve_Implicit_Dereference (Prefix (N));
       Analyze_Dimension (N);
    end Resolve_Selected_Component;
 
@@ -10712,9 +10738,12 @@ package body Sem_Res is
 
       Resolve (Name, Array_Type);
 
+      --  If the prefix's type is an access type, get to the real array type.
+      --  Note: we do not apply an access check because an explicit dereference
+      --  will be introduced later, and the check will happen there.
+
       if Is_Access_Type (Array_Type) then
-         Apply_Access_Check (N);
-         Array_Type := Designated_Type (Array_Type);
+         Array_Type := Implicitly_Designated_Type (Array_Type);
 
          --  If the prefix is an access to an unconstrained array, we must use
          --  the actual subtype of the object to perform the index checks. The
@@ -10858,6 +10887,7 @@ package body Sem_Res is
          Warn_On_Suspicious_Index (Name, High_Bound (Drange));
       end if;
 
+      Resolve_Implicit_Dereference (Prefix (N));
       Analyze_Dimension (N);
       Eval_Slice (N);
    end Resolve_Slice;
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index cce55a6..c6c8d10 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -1354,14 +1354,12 @@ package body Sem_Util is
          New_N : constant Node_Id := New_Copy_Tree (N);
 
       begin
-         if Is_Access_Type (Etype (New_N)) then
-            --  Copy the parent to have a proper Sloc on the dereference
+         if Is_Access_Type (Etype (N)) then
+            return Make_Explicit_Dereference (Sloc (Parent (N)), New_N);
 
-            Set_Parent (New_N, Parent (N));
-            Insert_Explicit_Dereference (New_N);
+         else
+            return New_N;
          end if;
-
-         return New_N;
       end Copy_And_Maybe_Dereference;
 
    --  Start of processing for Build_Actual_Subtype_Of_Component
@@ -12515,6 +12513,32 @@ package body Sem_Util is
       return False;
    end Implements_Interface;
 
+   --------------------------------
+   -- Implicitly_Designated_Type --
+   --------------------------------
+
+   function Implicitly_Designated_Type (Typ : Entity_Id) return Entity_Id is
+      Desig : constant Entity_Id := Designated_Type (Typ);
+
+   begin
+      --  An implicit dereference is a legal occurrence of an incomplete type
+      --  imported through a limited_with clause, if the full view is visible.
+
+      if Is_Incomplete_Type (Desig)
+        and then From_Limited_With (Desig)
+        and then not From_Limited_With (Scope (Desig))
+        and then
+          (Is_Immediately_Visible (Scope (Desig))
+            or else
+              (Is_Child_Unit (Scope (Desig))
+                and then Is_Visible_Lib_Unit (Scope (Desig))))
+      then
+         return Available_View (Desig);
+      else
+         return Desig;
+      end if;
+   end Implicitly_Designated_Type;
+
    ------------------------------------
    -- In_Assertion_Expression_Pragma --
    ------------------------------------
@@ -23402,7 +23426,7 @@ package body Sem_Util is
          Orig_Pre := Original_Node (Prefix (Orig_Obj));
 
          if Is_Access_Type (Etype (Orig_Pre)) then
-            return Type_Access_Level (Etype (Prefix (Orig_Obj)));
+            return Type_Access_Level (Etype (Orig_Pre));
          else
             return Object_Access_Level (Prefix (Orig_Obj));
          end if;
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index b794e80..2531844 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -1391,6 +1391,11 @@ package Sem_Util is
       Exclude_Parents : Boolean := False) return Boolean;
    --  Returns true if the Typ_Ent implements interface Iface_Ent
 
+   function Implicitly_Designated_Type (Typ : Entity_Id) return Entity_Id;
+   --  Called when Typ is the type of the prefix of an implicit dereference.
+   --  Return the designated type of Typ, taking into account that this type
+   --  may be a limited view, when the nonlimited view is visible.
+
    function In_Assertion_Expression_Pragma (N : Node_Id) return Boolean;
    --  Returns True if node N appears within a pragma that acts as an assertion
    --  expression. See Sem_Prag for the list of qualifying pragmas.
diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index ca019ef..3fe77b0 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -1872,7 +1872,7 @@ package body Sem_Warn is
       --  have a reference from generated code, it is bogus (e.g. calls to init
       --  procs to set default discriminant values).
 
-      if not Comes_From_Source (N) then
+      if not Comes_From_Source (Original_Node (N)) then
          return;
       end if;