decl.c (gnat_to_gnu_entity): When adjusting the discriminant nodes in an extension...

	* 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.

From-SVN: r148125

gcc/ada/ChangeLog

 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

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;

gcc/testsuite/ChangeLog

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

gcc/testsuite/gnat.dg/specs/root-level_1-level_2.ads

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

gcc/testsuite/gnat.dg/specs/root-level_1.ads

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

gcc/testsuite/gnat.dg/specs/root-level_2.ads

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

gcc/testsuite/gnat.dg/specs/root.ads

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