exp_aggr.adb (Rewrite_Discriminant): Rewriting must occur only for an expression referring to a discriminal of the...

2010-06-22  Thomas Quinot  <quinot@adacore.com>

	* exp_aggr.adb (Rewrite_Discriminant): Rewriting must occur only for an
	expression referring to a discriminal of the type of the aggregate (not
	a discriminal of some other unrelated type), and the prefix in the
	generated selected component must come from Lhs, not Obj.

2010-06-22  Thomas Quinot  <quinot@adacore.com>

	* sem_ch3.adb (Build_Derived_Record_Type): Fix predicate determining
	when to freeze the parent type.

From-SVN: r161195
This commit is contained in:
Thomas Quinot 2010-06-22 15:37:19 +00:00 committed by Arnaud Charlet
parent 1c612f2919
commit 61441c180d
3 changed files with 23 additions and 8 deletions

View File

@ -1,3 +1,15 @@
2010-06-22 Thomas Quinot <quinot@adacore.com>
* exp_aggr.adb (Rewrite_Discriminant): Rewriting must occur only for an
expression referring to a discriminal of the type of the aggregate (not
a discriminal of some other unrelated type), and the prefix in the
generated selected component must come from Lhs, not Obj.
2010-06-22 Thomas Quinot <quinot@adacore.com>
* sem_ch3.adb (Build_Derived_Record_Type): Fix predicate determining
when to freeze the parent type.
2010-06-22 Robert Dewar <dewar@adacore.com>
* s-rannum.adb, a-nudira.adb, types.ads, freeze.adb, sem_aggr.adb,

View File

@ -93,7 +93,7 @@ package body Exp_Aggr is
function Has_Default_Init_Comps (N : Node_Id) return Boolean;
-- N is an aggregate (record or array). Checks the presence of default
-- initialization (<>) in any component (Ada 2005: AI-287)
-- initialization (<>) in any component (Ada 2005: AI-287).
function Is_Static_Dispatch_Table_Aggregate (N : Node_Id) return Boolean;
-- Returns true if N is an aggregate used to initialize the components
@ -2431,10 +2431,12 @@ package body Exp_Aggr is
and then Present (Entity (Expr))
and then Ekind (Entity (Expr)) = E_In_Parameter
and then Present (Discriminal_Link (Entity (Expr)))
and then Scope (Discriminal_Link (Entity (Expr)))
= Base_Type (Etype (N))
then
Rewrite (Expr,
Make_Selected_Component (Loc,
Prefix => New_Occurrence_Of (Obj, Loc),
Prefix => New_Copy_Tree (Lhs),
Selector_Name => Make_Identifier (Loc, Chars (Expr))));
end if;
return OK;

View File

@ -6778,10 +6778,12 @@ package body Sem_Ch3 is
Mark_Rewrite_Insertion (New_Decl);
Insert_Before (N, New_Decl);
-- In the tagged case, make sure ancestor is frozen appropriately
-- In the extension case, make sure ancestor is frozen appropriately
-- (see also non-discriminated case below).
if not Private_Extension or else Is_Interface (Parent_Base) then
if Present (Record_Extension_Part (Type_Def))
or else Is_Interface (Parent_Base)
then
Freeze_Before (New_Decl, Parent_Type);
end if;
@ -16667,10 +16669,9 @@ package body Sem_Ch3 is
end loop;
end if;
-- For the tagged case, the two views can share the same
-- Primitive Operation list and the same class wide type.
-- Update attributes of the class-wide type which depend on
-- the full declaration.
-- For the tagged case, the two views can share the same primitive
-- operations list and the same class-wide type. Update attributes
-- of the class-wide type which depend on the full declaration.
if Is_Tagged_Type (Priv_T) then
Set_Primitive_Operations (Priv_T, Full_List);