[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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 67434655c8e9f9e198733f9fc981f0c1c967788d..950d1ddaaddfdd1cd62d0a09d9e99f30b58b15f1 100644 (file)
--- 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 c8cb1a4e44a2bcd45b46e6277e34c65c30ccb109..0018a673522cbb4279373437bfb5702d1e26f88c 100644 (file)
--- 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 81940dafcdaf8cf16553f40fd111bcc85c0d8cd4..b0493497c95f651a7f82a046e3b15d808434e037 100644 (file)
--- 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 (file)
index 0000000..70ea860
--- /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;
+