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
This commit is contained in:
Ed Schonberg
Geert Bosch
parent
d8d80dcd6c
commit
c84700e7c7
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 |
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 =>
|
||||
|
|
|
|||
Loading…
Reference in New Issue