diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index d922c3bf1a4..4c8dcae9d83 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -61,6 +61,7 @@ with Sem_Ch13;       use Sem_Ch13;
 with Sem_Eval;       use Sem_Eval;
 with Sem_Mech;       use Sem_Mech;
 with Sem_Res;        use Sem_Res;
+with Sem_Type;       use Sem_Type;
 with Sem_Util;       use Sem_Util;
                      use Sem_Util.Storage_Model_Support;
 with Sinfo;          use Sinfo;
@@ -2760,19 +2761,21 @@ package body Exp_Aggr is
 
       function Replace_Type (Expr : Node_Id) return Traverse_Result is
       begin
-         --  Note regarding the Root_Type test below: Aggregate components for
+         --  Note about the Is_Ancestor test below: aggregate components for
          --  self-referential types include attribute references to the current
-         --  instance, of the form: Typ'access, etc.. These references are
+         --  instance, of the form: Typ'access, etc. These references are
          --  rewritten as references to the target of the aggregate: the
          --  left-hand side of an assignment, the entity in a declaration,
-         --  or a temporary. Without this test, we would improperly extended
-         --  this rewriting to attribute references whose prefix was not the
+         --  or a temporary. Without this test, we would improperly extend
+         --  this rewriting to attribute references whose prefix is not the
          --  type of the aggregate.
 
          if Nkind (Expr) = N_Attribute_Reference
            and then Is_Entity_Name (Prefix (Expr))
            and then Is_Type (Entity (Prefix (Expr)))
-           and then Root_Type (Etype (N)) = Root_Type (Entity (Prefix (Expr)))
+           and then
+             Is_Ancestor
+               (Entity (Prefix (Expr)), Etype (N), Use_Full_View => True)
          then
             if Is_Entity_Name (Lhs) then
                Rewrite (Prefix (Expr), New_Occurrence_Of (Entity (Lhs), Loc));
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index 39189463871..5bfbde5052b 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -4546,14 +4546,17 @@ package body Sem_Aggr is
                Component_Associations (New_Aggr));
 
             --  If the discriminant constraint is a current instance, mark the
-            --  current aggregate so that the self-reference can be expanded
-            --  later. The constraint may refer to the subtype of aggregate, so
-            --  use base type for comparison.
+            --  current aggregate so that the self-reference can be expanded by
+            --  Build_Record_Aggr_Code.Replace_Type later.
 
             if Nkind (Discr_Val) = N_Attribute_Reference
               and then Is_Entity_Name (Prefix (Discr_Val))
               and then Is_Type (Entity (Prefix (Discr_Val)))
-              and then Base_Type (Etype (N)) = Entity (Prefix (Discr_Val))
+              and then
+                Is_Ancestor
+                  (Entity (Prefix (Discr_Val)),
+                   Etype (N),
+                   Use_Full_View => True)
             then
                Set_Has_Self_Reference (N);
             end if;
diff --git a/gcc/ada/sem_type.ads b/gcc/ada/sem_type.ads
index 6bc776a7319..e867885dac6 100644
--- a/gcc/ada/sem_type.ads
+++ b/gcc/ada/sem_type.ads
@@ -222,10 +222,9 @@ package Sem_Type is
      (T1            : Entity_Id;
       T2            : Entity_Id;
       Use_Full_View : Boolean := False) return Boolean;
-   --  T1 is a tagged type (not class-wide). Verify that it is one of the
-   --  ancestors of type T2 (which may or not be class-wide). If Use_Full_View
-   --  is True then the full-view of private parents is used when climbing
-   --  through the parents of T2.
+   --  T1 is a type (not class-wide). Verify that it is one of the ancestors of
+   --  type T2 (which may or not be class-wide). If Use_Full_View is True, then
+   --  the full view of private parents is used when climbing T2's parents.
    --
    --  Note: For analysis purposes the flag Use_Full_View must be set to False
    --  (otherwise we break the privacy contract since this routine returns true
