From c84700e7c77e92776dd951d8ce7e7e1efd0c0464 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Wed, 10 Oct 2001 22:46:39 +0000 Subject: [PATCH] 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 --- gcc/ada/ChangeLog | 23 +++++++++++++++++++++++ gcc/ada/checks.adb | 28 ++++++++++++++++++++++++---- gcc/ada/einfo.adb | 5 +++-- gcc/ada/einfo.ads | 6 +++--- gcc/ada/exp_aggr.adb | 20 +++++++++++++++++++- gcc/ada/exp_ch3.adb | 28 +++++++++++++--------------- 6 files changed, 85 insertions(+), 25 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 532efb47382..ce9ca1862f5 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,26 @@ +2001-10-10 Ed Schonberg + + * 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 * xeinfo.adb: Change int to char in translation of enumeration types. diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index b71b3ff99c1..27ccc084493 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 55c039431dd..6f7e0a3d3f6 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 eaa97c8800c..b521971a19b 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 92a7396fd63..e32fe91642e 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 76520cfdb9a..012e2543e50 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 =>