[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

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>
 

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
+               --  If we are expanding the initialization of a derived record
-                  Insert_Action (N, Make_Field_Assign (F, True));
+               --  that constrains or renames discriminants of the parent, we
+               --  must use the corresponding discriminant in the parent.
+
+               declare
+                  CF : Entity_Id;
+
+               begin
+                  if Inside_Init_Proc
+                    and then Present (Corresponding_Discriminant (F))
+                  then
+                     CF := Corresponding_Discriminant (F);
                   else
-                  Insert_Action (N, Make_Field_Assign (F));
+                     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;
 

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.

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;
+