* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Record_Type>: When

	adjusting the discriminant nodes in an extension, use the full view
	of the parent subtype if it is of a private kind.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@148125 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 4bce612..d439a19 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,11 @@
 2009-06-03  Eric Botcazou  <ebotcazou@adacore.com>
 
+       * gcc-interface/decl.c (gnat_to_gnu_entity) <E_Record_Type>: When
+       adjusting the discriminant nodes in an extension, use the full view
+       of the parent subtype if it is of a private kind.
+
+2009-06-03  Eric Botcazou  <ebotcazou@adacore.com>
+
        * gcc-interface/decl.c (gnat_to_gnu_entity) <E_Record_Type>: Add the
        _Parent field, if any, to the record before adding the other fields.
        <E_Record_Subtype>: Put the _Controller field before the other fields

diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index befb4f5..d32ddad 100644 (file)
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -2899,22 +2899,33 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
               of the parent subtype and not those of its base type for the
               placeholder machinery to properly work.  */
            if (Has_Discriminants (gnat_entity))
-             for (gnat_field = First_Stored_Discriminant (gnat_entity);
-                  Present (gnat_field);
-                  gnat_field = Next_Stored_Discriminant (gnat_field))
-               if (Present (Corresponding_Discriminant (gnat_field)))
+             {
+               /* The actual parent subtype is the full view.  */
+               if (IN (Ekind (gnat_parent), Private_Kind))
                  {
-                   Entity_Id field = Empty;
-                   for (field = First_Stored_Discriminant (gnat_parent);
-                        Present (field);
-                        field = Next_Stored_Discriminant (field))
-                     if (same_discriminant_p (gnat_field, field))
-                       break;
-                   gcc_assert (Present (field));
-                   TREE_OPERAND (get_gnu_tree (gnat_field), 1)
-                     = gnat_to_gnu_field_decl (field);
+                   if (Present (Full_View (gnat_parent)))
+                     gnat_parent = Full_View (gnat_parent);
+                   else
+                     gnat_parent = Underlying_Full_View (gnat_parent);
                  }
 
+               for (gnat_field = First_Stored_Discriminant (gnat_entity);
+                    Present (gnat_field);
+                    gnat_field = Next_Stored_Discriminant (gnat_field))
+                 if (Present (Corresponding_Discriminant (gnat_field)))
+                   {
+                     Entity_Id field = Empty;
+                     for (field = First_Stored_Discriminant (gnat_parent);
+                          Present (field);
+                          field = Next_Stored_Discriminant (field))
+                       if (same_discriminant_p (gnat_field, field))
+                         break;
+                     gcc_assert (Present (field));
+                     TREE_OPERAND (get_gnu_tree (gnat_field), 1)
+                       = gnat_to_gnu_field_decl (field);
+                   }
+             }
+
            /* The "get to the parent" COMPONENT_REF must be given its
               proper type...  */
            TREE_TYPE (gnu_get_parent) = gnu_parent;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index dcab467..981a891 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+2009-06-03  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gnat.dg/specs/root.ads: New test.
+       * gnat.dg/specs/root-level_1.ads: Likewise.
+       * gnat.dg/specs/root-level_2.ads: Likewise.
+       * gnat.dg/specs/root-level_1-level_2.ads: Likewise.
+
 2009-06-02  Mark Mitchell  <mark@codesourcery.com>
 
        * g++.dg/init/ref15.C: Require unwrapped targets.

diff --git a/gcc/testsuite/gnat.dg/specs/root-level_1-level_2.ads b/gcc/testsuite/gnat.dg/specs/root-level_1-level_2.ads
new file mode 100644 (file)
index 0000000..9687208
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/specs/root-level_1-level_2.ads
@@ -0,0 +1,7 @@
+package Root.Level_1.Level_2 is
+
+   type Level_2_Type (First  : Natural;
+                      Second : Natural) is new
+     Level_1.Level_1_Type (First => First, Second => Second) with null record;
+
+end Root.Level_1.Level_2;

diff --git a/gcc/testsuite/gnat.dg/specs/root-level_1.ads b/gcc/testsuite/gnat.dg/specs/root-level_1.ads
new file mode 100644 (file)
index 0000000..6bcb125
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/specs/root-level_1.ads
@@ -0,0 +1,14 @@
+package Root.Level_1 is
+
+   type Level_1_Type (First  : Natural;
+                      Second : Natural) is new Root_Type with private;
+
+private
+
+   type Level_1_Type (First  : Natural;
+                      Second : Natural) is new Root_Type (First => First)
+   with record
+      Buffer_1 : Buffer_Type (1 .. Second);
+   end record;
+
+end Root.Level_1;

diff --git a/gcc/testsuite/gnat.dg/specs/root-level_2.ads b/gcc/testsuite/gnat.dg/specs/root-level_2.ads
new file mode 100644 (file)
index 0000000..c4f812e
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/specs/root-level_2.ads
@@ -0,0 +1,9 @@
+with Root.Level_1;
+
+package Root.Level_2 is
+
+   type Level_2_Type (First  : Natural;
+                      Second : Natural) is new
+     Level_1.Level_1_Type (First => First, Second => Second) with null record;
+
+end Root.Level_2;

diff --git a/gcc/testsuite/gnat.dg/specs/root.ads b/gcc/testsuite/gnat.dg/specs/root.ads
new file mode 100644 (file)
index 0000000..e80ab88
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/specs/root.ads
@@ -0,0 +1,9 @@
+package Root is
+
+   type Buffer_Type is array (Positive range <>) of Natural;
+
+   type Root_Type (First : Natural) is abstract tagged record
+      Buffer_Root : Buffer_Type (1 .. First);
+   end record;
+
+end Root;