diff options
| author | Gary Dismukes <dismukes@adacore.com> | 2011-08-31 09:02:37 +0000 |
|---|---|---|
| committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2011-08-31 11:02:37 +0200 |
| commit | 0bb3bfb8feacd4bec3f0dc82d75cf1ea01d37010 (patch) | |
| tree | b537d5ed4f210cfdb6718b2d5e485201860cb3ee | |
| parent | 11fa950bd42cde0cd1c7c30b499250d145765561 (diff) | |
| download | gcc-0bb3bfb8feacd4bec3f0dc82d75cf1ea01d37010.zip gcc-0bb3bfb8feacd4bec3f0dc82d75cf1ea01d37010.tar.gz gcc-0bb3bfb8feacd4bec3f0dc82d75cf1ea01d37010.tar.bz2 | |
exp_ch5.adb (Expand_N_Assignment_Statement): When a discriminant check is needed for a left-hand side that is a dereference...
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.
From-SVN: r178362
| -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; |