diff options
| author | sam <sam@138bc75d-0d04-0410-961f-82ee72b054a4> | 2008-04-15 19:05:29 +0000 |
|---|---|---|
| committer | sam <sam@138bc75d-0d04-0410-961f-82ee72b054a4> | 2008-04-15 19:05:29 +0000 |
| commit | 0318d457d39b7fc1a3782b0f7bf8925b52599ab3 (patch) | |
| tree | b0574834c10dbab8128e37cc9354080be70ea76e | |
| parent | 220322c12d1e93f1a9ae6d385ce9396181bd37d6 (diff) | |
| download | gcc-0318d457d39b7fc1a3782b0f7bf8925b52599ab3.tar.gz | |
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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@134326 138bc75d-0d04-0410-961f-82ee72b054a4
| -rw-r--r-- | gcc/ada/ChangeLog | 7 | ||||
| -rw-r--r-- | gcc/ada/exp_ch5.adb | 29 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/specs/corr_discr.ads | 13 |
4 files changed, 48 insertions, 6 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 67434655c8e..950d1ddaadd 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 c8cb1a4e44a..0018a673522 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; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 81940dafcda..b0493497c95 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2008-04-15 Samuel Tardieu <sam@rfc1149.net> + + PR ada/22387 + * gnat.dg/specs/corr_discr.ads: New. + 2008-04-15 Eric Botcazou <ebotcazou@adacore.com> * gnat.dg/string_slice2.adb: New test. diff --git a/gcc/testsuite/gnat.dg/specs/corr_discr.ads b/gcc/testsuite/gnat.dg/specs/corr_discr.ads new file mode 100644 index 00000000000..70ea860565f --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/corr_discr.ads @@ -0,0 +1,13 @@ +package Corr_Discr is + + type Base (T1 : Boolean := True; T2 : Boolean := False) + is null record; + for Base use record + T1 at 0 range 0 .. 0; + T2 at 0 range 1 .. 1; + end record; + + type Deriv (D : Boolean := False) is new Base (T1 => True, T2 => D); + +end Corr_Discr; + |