einfo.ads, einfo.adb: New attribute Underlying_Record_View...

2009-04-17  Ed Schonberg  <schonberg@adacore.com>

	* einfo.ads, einfo.adb: New attribute Underlying_Record_View, to handle
	type extensions whose parent is a type with unknown discriminants.

	* exp_aggr.adb (Expand_Record_Aggregate): If the type of an extension
	aggregate has unknown discriminants, use the Underlying_Record_View to
	obtain the discriminants of the ancestor part.

	* exp_disp.adb (Build_Dispatch_Tables): Types that are
	Underlying_Record_Views share the dispatching information of the
	original record extension.

	* exp_ch3.adb (Expand_Record_Extension): If the type inherits unknown
	discriminants, propagate dispach table information to the
	Underlying_Record_View.

	* sem_ch3.adb (Build_Derived_Private_Type): If parent type has unknown
	discriminants and declaration is not a completion, generate
	Underlying_Record_View to provide proper discriminant information to
	the front-end and to gigi.

From-SVN: r146264

1 files changed, 20 insertions, 4 deletions

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 0ed20d0..bd9fb0d 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -2550,6 +2550,9 @@ package body Exp_Aggr is
             --  in the limited case, the ancestor part must be either a
             --  function call (possibly qualified, or wrapped in an unchecked
             --  conversion) or aggregate (definitely qualified).
+            --  The ancestor part can also be a function call (that may be
+            --  transformed into an explicit dereference) or a qualification
+            --  of one such.
 
             elsif Is_Limited_Type (Etype (A))
               and then Nkind (Unqualify (A)) /= N_Function_Call --  aggregate?
@@ -2557,6 +2560,7 @@ package body Exp_Aggr is
                 (Nkind (Unqualify (A)) /= N_Unchecked_Type_Conversion
                    or else
                  Nkind (Expression (Unqualify (A))) /= N_Function_Call)
+              and then Nkind (Unqualify (A)) /= N_Explicit_Dereference
             then
                Ancestor_Is_Expression := True;
 
@@ -3420,6 +3424,7 @@ package body Exp_Aggr is
 
    procedure Convert_To_Assignments (N : Node_Id; Typ : Entity_Id) is
       Loc  : constant Source_Ptr := Sloc (N);
+      T    : Entity_Id;
       Temp : Entity_Id;
 
       Instr       : Node_Id;
@@ -3524,18 +3529,29 @@ package body Exp_Aggr is
       else
          Temp := Make_Defining_Identifier (Loc, New_Internal_Name ('A'));
 
+         --  If the type inherits unknown discriminants, use the view with
+         --  known discriminants if available.
+
+         if Has_Unknown_Discriminants (Typ)
+            and then Present (Underlying_Record_View (Typ))
+         then
+            T := Underlying_Record_View (Typ);
+         else
+            T := Typ;
+         end if;
+
          Instr :=
            Make_Object_Declaration (Loc,
              Defining_Identifier => Temp,
-             Object_Definition   => New_Occurrence_Of (Typ, Loc));
+             Object_Definition   => New_Occurrence_Of (T, Loc));
 
          Set_No_Initialization (Instr);
          Insert_Action (N, Instr);
-         Initialize_Discriminants (Instr, Typ);
+         Initialize_Discriminants (Instr, T);
          Target_Expr := New_Occurrence_Of (Temp, Loc);
-         Insert_Actions (N, Build_Record_Aggr_Code (N, Typ, Target_Expr));
+         Insert_Actions (N, Build_Record_Aggr_Code (N, T, Target_Expr));
          Rewrite (N, New_Occurrence_Of (Temp, Loc));
-         Analyze_And_Resolve (N, Typ);
+         Analyze_And_Resolve (N, T);
       end if;
    end Convert_To_Assignments;