einfo.adb (Write_Field19_Name): Body_Entity is also defined for a generic package.

	* einfo.adb (Write_Field19_Name): Body_Entity is also defined for
	a generic package.

	* einfo.ads: Body_Entity is also defined for generic package.
	Documentation change only

	* exp_aggr.adb (Build_Array_Aggr_Code): When expanding an
	others_choice for a discriminated component initialization,
	convert discriminant references into the corresponding discriminals.

	* exp_ch3.adb (Get_Simple_Init_Val): Add qualification to aggregate
	only if original type is private and expression has to be wrapped
	in a conversion.

	* checks.adb:
	(Apply_Constraint_Check): Do not perform length check
	if expression is an aggregate with only an others_choice.
	(Length_N_Cond): two references to the same in_parameter
	(typically the discriminal in an init_proc) denote the same value.
	Two useful optimization uncovered by bugfixes above.

From-SVN: r46165

6 files changed, 85 insertions, 25 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 532efb4..ce9ca18 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,26 @@
+2001-10-10  Ed Schonberg <schonber@gnat.com>
+
+	* einfo.adb (Write_Field19_Name): Body_Entity is also defined for 
+	a generic package.
+
+	* einfo.ads: Body_Entity is also defined for generic package.
+	Documentation change only
+	
+	* exp_aggr.adb (Build_Array_Aggr_Code): When expanding an 
+	others_choice for a discriminated component initialization, 
+	convert discriminant references into the corresponding discriminals. 
+	
+	* exp_ch3.adb (Get_Simple_Init_Val): Add qualification to aggregate 
+	only if original type is private and expression has to be wrapped 
+	in a conversion.
+	
+	* checks.adb: 
+	(Apply_Constraint_Check): Do not perform length check 
+	if expression is an aggregate with only an others_choice.
+	(Length_N_Cond): two references to the same in_parameter 
+	(typically the discriminal in an init_proc) denote the same value.
+	Two useful optimization uncovered by bugfixes above.
+
 2001-10-10  Robert Dewar <dewar@gnat.com>
 
 	* xeinfo.adb: Change int to char in translation of enumeration types. 
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index b71b3ff..27ccc08 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                            $Revision: 1.205 $
+--                            $Revision$
 --                                                                          --
 --          Copyright (C) 1992-2001 Free Software Foundation, Inc.          --
 --                                                                          --
@@ -692,6 +692,18 @@ package body Checks is
 
       elsif Is_Array_Type (Typ) then
 
+         --  A useful optimization: an aggregate with only an Others clause
+         --  always has the right bounds.
+
+         if Nkind (N) = N_Aggregate
+           and then No (Expressions (N))
+           and then Nkind
+            (First (Choices (First (Component_Associations (N)))))
+              = N_Others_Choice
+         then
+            return;
+         end if;
+
          if Is_Constrained (Typ) then
             Apply_Length_Check (N, Typ);
 
@@ -2805,8 +2817,9 @@ package body Checks is
 
       function Same_Bounds (L : Node_Id; R : Node_Id) return Boolean;
       --  True for equal literals and for nodes that denote the same constant
-      --  entity, even if its value is not a static constant. This removes
-      --  some obviously superfluous checks.
+      --  entity, even if its value is not a static constant. This includes the
+      --  case of a discriminal reference within an init_proc. Removes some
+      --  obviously superfluous checks.
 
       function Length_E_Cond
         (Exptyp : Entity_Id;
@@ -3038,7 +3051,14 @@ package body Checks is
               and then Ekind (Entity (R)) = E_Constant
               and then Nkind (L) = N_Type_Conversion
               and then Is_Entity_Name (Expression (L))
-              and then Entity (R) = Entity (Expression (L)));
+              and then Entity (R) = Entity (Expression (L)))
+
+         or else
+            (Is_Entity_Name (L)
+              and then Is_Entity_Name (R)
+              and then Entity (L) = Entity (R)
+              and then Ekind (Entity (L)) = E_In_Parameter
+              and then Inside_Init_Proc);
       end Same_Bounds;
 
    --  Start of processing for Selected_Length_Checks
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index 55c0394..6f7e0a3 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                            $Revision: 1.630 $
+--                            $Revision$
 --                                                                          --
 --          Copyright (C) 1992-2001 Free Software Foundation, Inc.          --
 --                                                                          --
@@ -6569,7 +6569,8 @@ package body Einfo is
          when E_Discriminant                             =>
             Write_Str ("Corresponding_Discriminant");
 
-         when E_Package                                  =>
+         when E_Package                                  |
+              E_Generic_Package                          =>
             Write_Str ("Body_Entity");
 
          when E_Package_Body                             |
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index eaa97c8..b521971 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---                            $Revision: 1.640 $
+--                            $Revision$
 --                                                                          --
 --          Copyright (C) 1992-2001 Free Software Foundation, Inc.          --
 --                                                                          --
@@ -397,8 +397,8 @@ package Einfo is
 --       Present in block entities. Points to the Block_Statement itself.
 
 --    Body_Entity (Node19)
---       Present in package entities, points to the corresponding package
---       body entity if one is present.
+--       Present in package and generic package entities, points to the
+--       corresponding package body entity if one is present.
 
 --    C_Pass_By_Copy (Flag125) [implementation base type only]
 --       Present in record types. Set if a pragma Convention for the record
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 92a7396..e32fe91 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                            $Revision: 1.170 $
+--                            $Revision$
 --                                                                          --
 --          Copyright (C) 1992-2001 Free Software Foundation, Inc.          --
 --                                                                          --
@@ -1136,6 +1136,24 @@ package body Exp_Aggr is
                      High := Add (-1, To => Table (J + 1).Choice_Lo);
                   end if;
 
+                  --  If this is an expansion within an init_proc, make
+                  --  sure that discriminant references are replaced by
+                  --  the corresponding discriminal.
+
+                  if Inside_Init_Proc then
+                     if Is_Entity_Name (Low)
+                       and then Ekind (Entity (Low)) = E_Discriminant
+                     then
+                        Set_Entity (Low, Discriminal (Entity (Low)));
+                     end if;
+
+                     if Is_Entity_Name (High)
+                       and then Ekind (Entity (High)) = E_Discriminant
+                     then
+                        Set_Entity (High, Discriminal (Entity (High)));
+                     end if;
+                  end if;
+
                   if First
                     or else not Empty_Range (Low, High)
                   then
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 76520cf..012e254 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                            $Revision: 1.481 $
+--                            $Revision$
 --                                                                          --
 --          Copyright (C) 1992-2001 Free Software Foundation, Inc.          --
 --                                                                          --
@@ -4210,20 +4210,14 @@ package body Exp_Ch3 is
       then
          pragma Assert (Init_Or_Norm_Scalars);
 
-         --  Build aggregate with an explicit qualification, because it
-         --  may otherwise be ambiguous in context.
-
          return
-           Make_Qualified_Expression (Loc,
-             Subtype_Mark => New_Occurrence_Of (T, Loc),
-             Expression =>
-               Make_Aggregate (Loc,
-                 Component_Associations => New_List (
-                   Make_Component_Association (Loc,
-                     Choices => New_List (
-                       Make_Others_Choice (Loc)),
-                     Expression =>
-                       Get_Simple_Init_Val (Component_Type (T), Loc)))));
+           Make_Aggregate (Loc,
+             Component_Associations => New_List (
+               Make_Component_Association (Loc,
+                 Choices => New_List (
+                   Make_Others_Choice (Loc)),
+                 Expression =>
+                   Get_Simple_Init_Val (Component_Type (T), Loc))));
 
       --  Access type is initialized to null
 
@@ -4267,8 +4261,12 @@ package body Exp_Ch3 is
 
          --  A special case, if the underlying value is null, then qualify
          --  it with the underlying type, so that the null is properly typed
+         --  Similarly, if it is an aggregate it must be qualified, because
+         --  an unchecked conversion does not provide a context for it.
 
-         if Nkind (Val) = N_Null then
+         if Nkind (Val) = N_Null
+           or else Nkind (Val) = N_Aggregate
+         then
             Val :=
               Make_Qualified_Expression (Loc,
                 Subtype_Mark =>