diff options
| author | Samuel Tardieu <sam@gcc.gnu.org> | 2008-04-15 19:05:29 +0000 |
|---|---|---|
| committer | Samuel Tardieu <sam@gcc.gnu.org> | 2008-04-15 19:05:29 +0000 |
| commit | b48a653174158c79c24c1e347859e924a5c9a4ac (patch) | |
| tree | b0574834c10dbab8128e37cc9354080be70ea76e /gcc/ada | |
| parent | bd1f29d927823c063ef88658743c274034fa801a (diff) | |
| download | gcc-b48a653174158c79c24c1e347859e924a5c9a4ac.zip gcc-b48a653174158c79c24c1e347859e924a5c9a4ac.tar.gz gcc-b48a653174158c79c24c1e347859e924a5c9a4ac.tar.bz2 | |
[multiple changes]
2008-04-15 Ed Schonberg <schonberg@adacore.com>
gcc/ada/
PR ada/22387
* exp_ch5.adb (Expand_Assign_Record): Within an initialization
procedure for a derived type retrieve the discriminant values from
the parent using the corresponding discriminant.
2008-04-15 Samuel Tardieu <sam@rfc1149.net>
gcc/testsuite/
PR ada/22387
* gnat.dg/specs/corr_discr.ads: New.
From-SVN: r134326
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/ChangeLog | 7 | ||||
| -rw-r--r-- | gcc/ada/exp_ch5.adb | 29 |
2 files changed, 30 insertions, 6 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 6743465..950d1dd 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2008-04-15 Ed Schonberg <schonberg@adacore.com> + + PR ada/22387 + * exp_ch5.adb (Expand_Assign_Record): Within an initialization + procedure for a derived type retrieve the discriminant values from + the parent using the corresponding discriminant. + 2008-04-15 Samuel Tardieu <sam@rfc1149.net> Gary Dismukes <dismukes@adacore.com> diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index c8cb1a4..0018a67 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -1345,13 +1345,30 @@ package body Exp_Ch5 is F := First_Discriminant (R_Typ); while Present (F) loop - if Is_Unchecked_Union (Base_Type (R_Typ)) then - Insert_Action (N, Make_Field_Assign (F, True)); - else - Insert_Action (N, Make_Field_Assign (F)); - end if; + -- If we are expanding the initialization of a derived record + -- that constrains or renames discriminants of the parent, we + -- must use the corresponding discriminant in the parent. + + declare + CF : Entity_Id; - Next_Discriminant (F); + begin + if Inside_Init_Proc + and then Present (Corresponding_Discriminant (F)) + then + CF := Corresponding_Discriminant (F); + else + CF := F; + end if; + + if Is_Unchecked_Union (Base_Type (R_Typ)) then + Insert_Action (N, Make_Field_Assign (CF, True)); + else + Insert_Action (N, Make_Field_Assign (CF)); + end if; + + Next_Discriminant (F); + end; end loop; end if; |