ada: Fix spurious visibility error on parent's component in instance

This occurs for an aggregate of a derived tagged type in the body of the
instance, because the full view of the parent type, which was visible in
the generic construct (otherwise the aggregate would have been illegal),
is not restored in the body of the instance.

Copy_Generic_Node already contains code to restore the full view in this
case, but it works only if the derived tagged type is itself global to
the generic construct, and not if the derived tagged type is local but
the parent type global, as is the case here.

gcc/ada/

	* gen_il-fields.ads (Aggregate_Bounds): Rename to
	Aggregate_Bounds_Or_Ancestor_Type.
	* gen_il-gen-gen_nodes.adb (Aggregate_Bounds): Likewise.
	* sem_aggr.adb (Resolve_Record_Aggregate): Remove obsolete bypass.
	* sem_ch12.adb (Check_Generic_Actuals): Add decoration.
	(Copy_Generic_Node): For an extension aggregate, restore only the
	full view, if any.  For a full aggregate, restore the full view as
	well as that of its Ancestor_Type, if any, and up to the root type.
	(Save_References_In_Aggregate): For a full aggregate of a local
	derived tagged type with a global ancestor, set Ancestor_Type to
	this ancestor.  For a full aggregate of a global derived tagged
	type, set Ancestor_Type to the parent type.
	* sinfo-utils.ads (Aggregate_Bounds): New function renaming.
	(Ancestor_Type): Likewise.
	(Set_Aggregate_Bounds): New procedure renaming.
	(Set_Ancestor_Type): Likewise.
	* sinfo.ads (Ancestor_Type): Document new field.

6 files changed, 107 insertions, 35 deletions

diff --git a/gcc/ada/gen_il-fields.ads b/gcc/ada/gen_il-fields.ads
index c565e19..632ce48 100644
--- a/gcc/ada/gen_il-fields.ads
+++ b/gcc/ada/gen_il-fields.ads
@@ -66,7 +66,7 @@ package Gen_IL.Fields is
       Acts_As_Spec,
       Actual_Designated_Subtype,
       Address_Warning_Posted,
-      Aggregate_Bounds,
+      Aggregate_Bounds_Or_Ancestor_Type,
       Aliased_Present,
       All_Others,
       All_Present,
diff --git a/gcc/ada/gen_il-gen-gen_nodes.adb b/gcc/ada/gen_il-gen-gen_nodes.adb
index 087f785..064d25f 100644
--- a/gcc/ada/gen_il-gen-gen_nodes.adb
+++ b/gcc/ada/gen_il-gen-gen_nodes.adb
@@ -493,7 +493,7 @@ begin -- Gen_IL.Gen.Gen_Nodes
         Sy (Is_Parenthesis_Aggregate, Flag),
         Sy (Is_Homogeneous_Aggregate, Flag),
         Sy (Is_Enum_Array_Aggregate, Flag),
-        Sm (Aggregate_Bounds, Node_Id),
+        Sm (Aggregate_Bounds_Or_Ancestor_Type, Node_Id),
         Sm (Entity_Or_Associated_Node, Node_Id), -- just Associated_Node
         Sm (Compile_Time_Known_Aggregate, Flag),
         Sm (Expansion_Delayed, Flag),
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index e1e7b8b..a61326c 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -5644,18 +5644,14 @@ package body Sem_Aggr is
                Parent_Typ := Etype (Parent_Typ);
 
                --  Check whether a private parent requires the use of
-               --  an extension aggregate. This test does not apply in
-               --  an instantiation: if the generic unit is legal so is
-               --  the instance.
+               --  an extension aggregate.
 
                if Nkind (Parent (Base_Type (Parent_Typ))) =
                                         N_Private_Type_Declaration
                  or else Nkind (Parent (Base_Type (Parent_Typ))) =
                                         N_Private_Extension_Declaration
                then
-                  if Nkind (N) /= N_Extension_Aggregate
-                    and then not In_Instance
-                  then
+                  if Nkind (N) /= N_Extension_Aggregate then
                      Error_Msg_NE
                        ("type of aggregate has private ancestor&!",
                         N, Parent_Typ);
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index e229d21..2b8436d 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -7059,10 +7059,14 @@ package body Sem_Ch12 is
          end if;
       end Check_Actual_Type;
 
+      --  Local variables
+
       Astype : Entity_Id;
       E      : Entity_Id;
       Formal : Node_Id;
 
+   --  Start of processing for Check_Generic_Actuals
+
    begin
       E := First_Entity (Instance);
       while Present (E) loop
@@ -8495,38 +8499,46 @@ package body Sem_Ch12 is
             Set_Associated_Node (N, New_N);
 
          else
-            if Present (Get_Associated_Node (N))
-              and then Nkind (Get_Associated_Node (N)) = Nkind (N)
-            then
-               --  In the generic the aggregate has some composite type. If at
-               --  the point of instantiation the type has a private view,
-               --  install the full view (and that of its ancestors, if any).
+            --  If, in the generic, the aggregate has a global composite type
+            --  and, at the point of instantiation, the type has a private view
+            --  then install the full view.
 
-               declare
-                  T   : Entity_Id := Etype (Get_Associated_Node (N));
-                  Rt  : Entity_Id;
+            declare
+               Assoc : constant Node_Id := Get_Associated_Node (N);
 
-               begin
-                  if Present (T) and then Is_Private_Type (T) then
-                     Switch_View (T);
-                  end if;
+            begin
+               if Present (Assoc)
+                 and then Nkind (Assoc) = Nkind (N)
+                 and then Present (Etype (Assoc))
+                 and then Is_Private_Type (Etype (Assoc))
+               then
+                  Switch_View (Etype (Assoc));
+               end if;
+            end;
 
-                  if Present (T)
-                    and then Is_Tagged_Type (T)
-                    and then Is_Derived_Type (T)
-                  then
-                     Rt := Root_Type (T);
+            --  Moreover, for a full aggregate, if the type is a derived tagged
+            --  type and has a global ancestor, then also restore the full view
+            --  of this ancestor, and do so up to the root type.
 
-                     loop
-                        T := Etype (T);
+            if Nkind (N) = N_Aggregate
+              and then Present (Ancestor_Type (N))
+            then
+               declare
+                  Root_Typ : constant Entity_Id :=
+                               Root_Type (Ancestor_Type (N));
 
-                        if Is_Private_Type (T) then
-                           Switch_View (T);
-                        end if;
+                  Typ : Entity_Id := Ancestor_Type (N);
 
-                        exit when T = Rt;
-                     end loop;
-                  end if;
+               begin
+                  loop
+                     if Is_Private_Type (Typ) then
+                        Switch_View (Typ);
+                     end if;
+
+                     exit when Typ = Root_Typ;
+
+                     Typ := Etype (Typ);
+                  end loop;
                end;
             end if;
          end if;
@@ -16505,6 +16517,36 @@ package body Sem_Ch12 is
             if No (N2) or else No (Typ) or else not Is_Global (Typ) then
                Set_Associated_Node (N, Empty);
 
+               --  For a full aggregate, if the type is local but is a derived
+               --  tagged type of a global ancestor, we will need to have the
+               --  full view of this global ancestor available in the instance
+               --  in order to analyze the full aggregate.
+
+               if Present (N2)
+                 and then Nkind (N2) = N_Aggregate
+                 and then Present (Typ)
+                 and then Is_Tagged_Type (Typ)
+                 and then Is_Derived_Type (Typ)
+               then
+                  declare
+                     Root_Typ : constant Entity_Id := Root_Type (Typ);
+
+                     Parent_Typ : Entity_Id := Typ;
+
+                  begin
+                     loop
+                        Parent_Typ := Etype (Parent_Typ);
+
+                        if Is_Global (Parent_Typ) then
+                           Set_Ancestor_Type (N, Parent_Typ);
+                           exit;
+                        end if;
+
+                        exit when Parent_Typ = Root_Typ;
+                     end loop;
+                  end;
+               end if;
+
                --  If the aggregate is an actual in a call, it has been
                --  resolved in the current context, to some local type. The
                --  enclosing call may have been disambiguated by the aggregate,
@@ -16543,6 +16585,19 @@ package body Sem_Ch12 is
                       Subtype_Mark => Nam,
                       Expression   => Relocate_Node (N));
                end if;
+
+            --  For a full aggregate, if the type is global and a derived
+            --  tagged type, we will also need to have the full view of its
+            --  ancestor available in the instance in order to analyze the
+            --  full aggregate.
+
+            elsif Present (N2)
+              and then Nkind (N2) = N_Aggregate
+              and then Present (Typ)
+              and then Is_Tagged_Type (Typ)
+              and then Is_Derived_Type (Typ)
+            then
+               Set_Ancestor_Type (N, Etype (Typ));
             end if;
 
             if Nkind (N) = N_Aggregate then
diff --git a/gcc/ada/sinfo-utils.ads b/gcc/ada/sinfo-utils.ads
index 6ce6248..75d8d25 100644
--- a/gcc/ada/sinfo-utils.ads
+++ b/gcc/ada/sinfo-utils.ads
@@ -157,6 +157,22 @@ package Sinfo.Utils is
      (N : N_Inclusive_Has_Entity; Val : Node_Id)
       renames Set_Entity_Or_Associated_Node;
 
+   ---------------------------------------------------
+   -- Aliases for Aggregate_Bounds_Or_Ancestor_Type --
+   ---------------------------------------------------
+
+   function Aggregate_Bounds (N : Node_Id) return Node_Id
+      renames Aggregate_Bounds_Or_Ancestor_Type;
+
+   function Ancestor_Type (N : Node_Id) return Node_Id
+      renames Aggregate_Bounds_Or_Ancestor_Type;
+
+   procedure Set_Aggregate_Bounds (N : Node_Id; Val : Node_Id)
+      renames Set_Aggregate_Bounds_Or_Ancestor_Type;
+
+   procedure Set_Ancestor_Type (N : Node_Id; Val : Node_Id)
+      renames Set_Aggregate_Bounds_Or_Ancestor_Type;
+
    ---------------
    -- Debugging --
    ---------------
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index 1a63170..fc4589d 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -845,6 +845,11 @@ package Sinfo is
    --    is used for translation of the at end handler into a normal exception
    --    handler.
 
+   --  Ancestor_Type
+   --    Present in record N_Aggregate nodes. Used to store the first global
+   --    ancestor of the type of the aggregate in a generic context, if any,
+   --    when the type is a derived tagged type. Otherwise Empty.
+
    --  Aspect_On_Partial_View
    --    Present on an N_Aspect_Specification node. For an aspect that applies
    --    to a type entity, indicates whether the specification appears on the
@@ -4081,7 +4086,7 @@ package Sinfo is
       --  Expressions (set to No_List if none or null record case)
       --  Component_Associations (set to No_List if none)
       --  Null_Record_Present
-      --  Aggregate_Bounds
+      --  Aggregate_Bounds (array) or Ancestor_Type (record)
       --  Associated_Node
       --  Compile_Time_Known_Aggregate
       --  Expansion_Delayed