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
|
@ -1260,8 +1260,11 @@ package body Sem_Aggr is
|
||||||
|
|
||||||
OK_L : Boolean;
|
OK_L : Boolean;
|
||||||
OK_H : Boolean;
|
OK_H : Boolean;
|
||||||
|
|
||||||
OK_AL : Boolean;
|
OK_AL : Boolean;
|
||||||
OK_AH : Boolean;
|
OK_AH : Boolean;
|
||||||
|
pragma Warnings (Off, OK_AL);
|
||||||
|
pragma Warnings (Off, OK_AH);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Raises_Constraint_Error (N)
|
if Raises_Constraint_Error (N)
|
||||||
|
@ -1464,7 +1467,8 @@ package body Sem_Aggr is
|
||||||
Choice : Node_Id;
|
Choice : Node_Id;
|
||||||
Expr : Node_Id;
|
Expr : Node_Id;
|
||||||
|
|
||||||
Who_Cares : Node_Id;
|
Discard : Node_Id;
|
||||||
|
pragma Warnings (Off, Discard);
|
||||||
|
|
||||||
Aggr_Low : Node_Id := Empty;
|
Aggr_Low : Node_Id := Empty;
|
||||||
Aggr_High : Node_Id := Empty;
|
Aggr_High : Node_Id := Empty;
|
||||||
|
@ -1881,7 +1885,7 @@ package body Sem_Aggr is
|
||||||
|
|
||||||
else
|
else
|
||||||
if Others_Allowed then
|
if Others_Allowed then
|
||||||
Get_Index_Bounds (Index_Constr, Aggr_Low, Who_Cares);
|
Get_Index_Bounds (Index_Constr, Aggr_Low, Discard);
|
||||||
else
|
else
|
||||||
Aggr_Low := Index_Typ_Low;
|
Aggr_Low := Index_Typ_Low;
|
||||||
end if;
|
end if;
|
||||||
|
@ -2984,27 +2988,17 @@ package body Sem_Aggr is
|
||||||
Expr := Get_Value (Component, Component_Associations (N), True);
|
Expr := Get_Value (Component, Component_Associations (N), True);
|
||||||
|
|
||||||
-- Note: The previous call to Get_Value sets the value of the
|
-- 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.
|
-- Ada 2005 (AI-287): Handle components with default initialization.
|
||||||
-- Note: This feature was originally added to Ada 2005 for limited
|
-- Note: This feature was originally added to Ada 2005 for limited
|
||||||
-- but it was finally allowed with any type.
|
-- but it was finally allowed with any type.
|
||||||
|
|
||||||
if Is_Box_Present then
|
if Is_Box_Present then
|
||||||
declare
|
Check_Box_Component : declare
|
||||||
Is_Array_Subtype : constant Boolean :=
|
Ctyp : constant Entity_Id := Etype (Component);
|
||||||
Ekind (Etype (Component)) =
|
|
||||||
E_Array_Subtype;
|
|
||||||
|
|
||||||
Ctyp : Entity_Id;
|
|
||||||
|
|
||||||
begin
|
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
|
-- If there is a default expression for the aggregate, copy
|
||||||
-- it into a new association.
|
-- it into a new association.
|
||||||
|
|
||||||
|
@ -3033,6 +3027,42 @@ package body Sem_Aggr is
|
||||||
Expr => Expr);
|
Expr => Expr);
|
||||||
Set_Has_Self_Reference (N);
|
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)
|
elsif Has_Non_Null_Base_Init_Proc (Ctyp)
|
||||||
or else not Expander_Active
|
or else not Expander_Active
|
||||||
then
|
then
|
||||||
|
@ -3143,16 +3173,11 @@ package body Sem_Aggr is
|
||||||
-- expand the corresponding assignments and run-time checks).
|
-- expand the corresponding assignments and run-time checks).
|
||||||
|
|
||||||
elsif Present (Expr)
|
elsif Present (Expr)
|
||||||
and then
|
and then Is_Partially_Initialized_Type (Ctyp)
|
||||||
((not Is_Array_Subtype
|
|
||||||
and then Is_Partially_Initialized_Type (Component))
|
|
||||||
or else
|
|
||||||
(Is_Array_Subtype
|
|
||||||
and then Is_Partially_Initialized_Type (Ctyp)))
|
|
||||||
then
|
then
|
||||||
Resolve_Aggr_Expr (Expr, Component);
|
Resolve_Aggr_Expr (Expr, Component);
|
||||||
end if;
|
end if;
|
||||||
end;
|
end Check_Box_Component;
|
||||||
|
|
||||||
elsif No (Expr) then
|
elsif No (Expr) then
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue