From b48a653174158c79c24c1e347859e924a5c9a4ac Mon Sep 17 00:00:00 2001
From: Samuel Tardieu <sam@gcc.gnu.org>
Date: Tue, 15 Apr 2008 19:05:29 +0000
Subject: [PATCH] [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                          |  7 ++++++
 gcc/ada/exp_ch5.adb                        | 29 +++++++++++++++++-----
 gcc/testsuite/ChangeLog                    |  5 ++++
 gcc/testsuite/gnat.dg/specs/corr_discr.ads | 13 ++++++++++
 4 files changed, 48 insertions(+), 6 deletions(-)
 create mode 100644 gcc/testsuite/gnat.dg/specs/corr_discr.ads

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.
 
-               Next_Discriminant (F);
+               declare
+                  CF : Entity_Id;
+
+               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;
+