sem_aggr.adb (Resolve_Record_Aggregate): In the case of a box association for an access component...
2007-10-15 Gary Dismukes <dismukes@adacore.com> * sem_aggr.adb (Resolve_Record_Aggregate): In the case of a box association for an access component, add an association with null as the expression. Remove testing for array subtypes and the setting in that case of Ctyp to the array component type, which prevented proper inclusion of an association for null-initialized arrays. Collapse condition that tests for array subtypes into just a test of Is_Partially_Initialized_Type (which already covers arrays anyway). From-SVN: r129331
This commit is contained in:
parent
3d63f8c9a1
commit
f91e80203a
|
@ -1258,10 +1258,13 @@ package body Sem_Aggr is
|
|||
Val_AL : Uint;
|
||||
Val_AH : Uint;
|
||||
|
||||
OK_L : Boolean;
|
||||
OK_H : Boolean;
|
||||
OK_L : Boolean;
|
||||
OK_H : Boolean;
|
||||
|
||||
OK_AL : Boolean;
|
||||
OK_AH : Boolean;
|
||||
OK_AH : Boolean;
|
||||
pragma Warnings (Off, OK_AL);
|
||||
pragma Warnings (Off, OK_AH);
|
||||
|
||||
begin
|
||||
if Raises_Constraint_Error (N)
|
||||
|
@ -1464,7 +1467,8 @@ package body Sem_Aggr is
|
|||
Choice : Node_Id;
|
||||
Expr : Node_Id;
|
||||
|
||||
Who_Cares : Node_Id;
|
||||
Discard : Node_Id;
|
||||
pragma Warnings (Off, Discard);
|
||||
|
||||
Aggr_Low : Node_Id := Empty;
|
||||
Aggr_High : Node_Id := Empty;
|
||||
|
@ -1881,7 +1885,7 @@ package body Sem_Aggr is
|
|||
|
||||
else
|
||||
if Others_Allowed then
|
||||
Get_Index_Bounds (Index_Constr, Aggr_Low, Who_Cares);
|
||||
Get_Index_Bounds (Index_Constr, Aggr_Low, Discard);
|
||||
else
|
||||
Aggr_Low := Index_Typ_Low;
|
||||
end if;
|
||||
|
@ -2984,27 +2988,17 @@ package body Sem_Aggr is
|
|||
Expr := Get_Value (Component, Component_Associations (N), True);
|
||||
|
||||
-- Note: The previous call to Get_Value sets the value of the
|
||||
-- variable Is_Box_Present
|
||||
-- variable Is_Box_Present.
|
||||
|
||||
-- Ada 2005 (AI-287): Handle components with default initialization.
|
||||
-- Note: This feature was originally added to Ada 2005 for limited
|
||||
-- but it was finally allowed with any type.
|
||||
|
||||
if Is_Box_Present then
|
||||
declare
|
||||
Is_Array_Subtype : constant Boolean :=
|
||||
Ekind (Etype (Component)) =
|
||||
E_Array_Subtype;
|
||||
|
||||
Ctyp : Entity_Id;
|
||||
Check_Box_Component : declare
|
||||
Ctyp : constant Entity_Id := Etype (Component);
|
||||
|
||||
begin
|
||||
if Is_Array_Subtype then
|
||||
Ctyp := Component_Type (Base_Type (Etype (Component)));
|
||||
else
|
||||
Ctyp := Etype (Component);
|
||||
end if;
|
||||
|
||||
-- If there is a default expression for the aggregate, copy
|
||||
-- it into a new association.
|
||||
|
||||
|
@ -3033,6 +3027,42 @@ package body Sem_Aggr is
|
|||
Expr => Expr);
|
||||
Set_Has_Self_Reference (N);
|
||||
|
||||
-- A box-defaulted access component gets the value null. Also
|
||||
-- included are components of private types whose underlying
|
||||
-- type is an access type.
|
||||
|
||||
elsif Present (Underlying_Type (Ctyp))
|
||||
and then Is_Access_Type (Underlying_Type (Ctyp))
|
||||
then
|
||||
if not Is_Private_Type (Ctyp) then
|
||||
Add_Association
|
||||
(Component => Component,
|
||||
Expr => Make_Null (Sloc (N)));
|
||||
|
||||
-- If the component's type is private with an access type as
|
||||
-- its underlying type then we have to create an unchecked
|
||||
-- conversion to satisfy type checking.
|
||||
|
||||
else
|
||||
declare
|
||||
Qual_Null : constant Node_Id :=
|
||||
Make_Qualified_Expression (Sloc (N),
|
||||
Subtype_Mark =>
|
||||
New_Occurrence_Of
|
||||
(Underlying_Type (Ctyp), Sloc (N)),
|
||||
Expression => Make_Null (Sloc (N)));
|
||||
|
||||
Convert_Null : constant Node_Id :=
|
||||
Unchecked_Convert_To
|
||||
(Ctyp, Qual_Null);
|
||||
|
||||
begin
|
||||
Analyze_And_Resolve (Convert_Null, Ctyp);
|
||||
Add_Association
|
||||
(Component => Component, Expr => Convert_Null);
|
||||
end;
|
||||
end if;
|
||||
|
||||
elsif Has_Non_Null_Base_Init_Proc (Ctyp)
|
||||
or else not Expander_Active
|
||||
then
|
||||
|
@ -3143,16 +3173,11 @@ package body Sem_Aggr is
|
|||
-- expand the corresponding assignments and run-time checks).
|
||||
|
||||
elsif Present (Expr)
|
||||
and then
|
||||
((not Is_Array_Subtype
|
||||
and then Is_Partially_Initialized_Type (Component))
|
||||
or else
|
||||
(Is_Array_Subtype
|
||||
and then Is_Partially_Initialized_Type (Ctyp)))
|
||||
and then Is_Partially_Initialized_Type (Ctyp)
|
||||
then
|
||||
Resolve_Aggr_Expr (Expr, Component);
|
||||
end if;
|
||||
end;
|
||||
end Check_Box_Component;
|
||||
|
||||
elsif No (Expr) then
|
||||
|
||||
|
|
Loading…
Reference in New Issue