diff options
| author | Thomas Quinot <quinot@adacore.com> | 2010-06-22 15:37:19 +0000 |
|---|---|---|
| committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2010-06-22 17:37:19 +0200 |
| commit | 61441c180d516ccd0bc878dc3aef3fd2d89f02dd (patch) | |
| tree | 3edc0ad169e584723e8ba71b0af78101fdbc0a81 | |
| parent | 1c612f29199ea74e57bd9872e11ee726703aab2f (diff) | |
| download | gcc-61441c180d516ccd0bc878dc3aef3fd2d89f02dd.zip gcc-61441c180d516ccd0bc878dc3aef3fd2d89f02dd.tar.gz gcc-61441c180d516ccd0bc878dc3aef3fd2d89f02dd.tar.bz2 | |
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
| -rw-r--r-- | gcc/ada/ChangeLog | 12 | ||||
| -rw-r--r-- | gcc/ada/exp_aggr.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/sem_ch3.adb | 13 |
3 files changed, 23 insertions, 8 deletions
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 <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, 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); |