From 61441c180d516ccd0bc878dc3aef3fd2d89f02dd Mon Sep 17 00:00:00 2001 From: Thomas Quinot Date: Tue, 22 Jun 2010 15:37:19 +0000 Subject: exp_aggr.adb (Rewrite_Discriminant): Rewriting must occur only for an expression referring to a discriminal of the... 2010-06-22 Thomas Quinot * 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 * sem_ch3.adb (Build_Derived_Record_Type): Fix predicate determining when to freeze the parent type. From-SVN: r161195 --- gcc/ada/ChangeLog | 12 ++++++++++++ gcc/ada/exp_aggr.adb | 6 ++++-- gcc/ada/sem_ch3.adb | 13 +++++++------ 3 files changed, 23 insertions(+), 8 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b80c597..0af660d9 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,15 @@ +2010-06-22 Thomas Quinot + + * 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 + + * sem_ch3.adb (Build_Derived_Record_Type): Fix predicate determining + when to freeze the parent type. + 2010-06-22 Robert Dewar * s-rannum.adb, a-nudira.adb, types.ads, freeze.adb, sem_aggr.adb, diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index c4e3b01..925a704 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -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; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 1cb03ba..f1aaf61 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -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); -- cgit v1.1