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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@46165
138bc75d-0d04-0410-961f-
82ee72b054a4
+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.
-- --
-- B o d y --
-- --
--- $Revision: 1.205 $
+-- $Revision$
-- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- --
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);
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;
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
-- --
-- B o d y --
-- --
--- $Revision: 1.630 $
+-- $Revision$
-- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- --
when E_Discriminant =>
Write_Str ("Corresponding_Discriminant");
- when E_Package =>
+ when E_Package |
+ E_Generic_Package =>
Write_Str ("Body_Entity");
when E_Package_Body |
-- --
-- S p e c --
-- --
--- $Revision: 1.640 $
+-- $Revision$
-- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- --
-- 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
-- --
-- B o d y --
-- --
--- $Revision: 1.170 $
+-- $Revision$
-- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- --
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
-- --
-- B o d y --
-- --
--- $Revision: 1.481 $
+-- $Revision$
-- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- --
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
-- 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 =>
projects / platform / upstream / linaro-gcc.git / commitdiff