From: Samuel Tardieu Date: Tue, 15 Apr 2008 19:05:29 +0000 (+0000) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=b48a653174158c79c24c1e347859e924a5c9a4ac;p=gcc.git [multiple changes] 2008-04-15 Ed Schonberg 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 gcc/testsuite/ PR ada/22387 * gnat.dg/specs/corr_discr.ads: New. From-SVN: r134326 --- 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 + + 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 Gary Dismukes 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 + + PR ada/22387 + * gnat.dg/specs/corr_discr.ads: New. + 2008-04-15 Eric Botcazou * 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; +