diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 9 | ||||
| -rw-r--r-- | gcc/ada/exp_ch5.adb | 28 |
2 files changed, 31 insertions, 6 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a2c2cd3..bcb79fc 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,12 @@ +2011-08-31 Gary Dismukes <dismukes@adacore.com> + + * exp_ch5.adb (Expand_N_Assignment_Statement): When a discriminant + check is needed for a left-hand side that is a dereference, and the + base type is private without discriminants (whereas the full type does + have discriminants), an extra retrieval of the underlying type may be + needed in the case where the subtype is a record subtype whose base + type is private. Update comments. + 2011-08-31 Javier Miranda <miranda@adacore.com> * sem_ch4.adb (Try_Object_Operation): When a dispatching primitive is diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 9362d7d..329f779 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -1788,9 +1788,8 @@ package body Exp_Ch5 is -- If the type is private without discriminants, and the full type -- has discriminants (necessarily with defaults) a check may still be - -- necessary if the Lhs is aliased. The private determinants must be + -- necessary if the Lhs is aliased. The private discriminants must be -- visible to build the discriminant constraints. - -- What is a "determinant"??? -- Only an explicit dereference that comes from source indicates -- aliasing. Access to formals of protected operations and entries @@ -1802,11 +1801,28 @@ package body Exp_Ch5 is and then Comes_From_Source (Lhs) then declare - Lt : constant Entity_Id := Etype (Lhs); + Lt : constant Entity_Id := Etype (Lhs); + Ubt : Entity_Id := Base_Type (Typ); + begin - Set_Etype (Lhs, Typ); - Rewrite (Rhs, OK_Convert_To (Base_Type (Typ), Rhs)); - Apply_Discriminant_Check (Rhs, Typ, Lhs); + -- In the case of an expander-generated record subtype whose base + -- type still appears private, Typ will have been set to that + -- private type rather than the underlying record type (because + -- Underlying type will have returned the record subtype), so it's + -- necessary to apply Underlying_Type again to the base type to + -- get the record type we need for the discriminant check. Such + -- subtypes can be created for assignments in certain cases, such + -- as within an instantiation passed this kind of private type. + -- It would be good to avoid this special test, but making changes + -- to prevent this odd form of record subtype seems difficult. ??? + + if Is_Private_Type (Ubt) then + Ubt := Underlying_Type (Ubt); + end if; + + Set_Etype (Lhs, Ubt); + Rewrite (Rhs, OK_Convert_To (Base_Type (Ubt), Rhs)); + Apply_Discriminant_Check (Rhs, Ubt, Lhs); Set_Etype (Lhs, Lt); end; |