decl.c (gnat_to_gnu_entity): In the renaming case...

* gcc-interface/decl.c (gnat_to_gnu_entity) <object>: In the renaming
	case, use the padded type if the renamed object has an unconstrained
	type with default discriminant.

From-SVN: r187209

gcc/ada/ChangeLog

@@ -1,9 +1,15 @@
+2012-05-06  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gcc-interface/decl.c (gnat_to_gnu_entity) <object>: In the renaming
+	case, use the padded type if the renamed object has an unconstrained
+	type with default discriminant.
+
 2012-05-06  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* gcc-interface/trans.c (Loop_Statement_to_gnu): Also handle invariant
 	conditions with only one bound.
-	(Raise_Error_to_gnu): Likewise.  New function extracted from...
-	(gnat_to_gnu) <N_Raise_Constraint_Error>: ...here.  Call above function
+	(Raise_Error_to_gnu): Likewise.  New function extracted from...
+	(gnat_to_gnu) <N_Raise_Constraint_Error>: ...here.  Call above function
 	in regular mode only.
 
 2012-05-06  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/gcc-interface/decl.c

@@ -938,6 +938,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 		gnu_type = TREE_TYPE (gnu_expr);
 	      }
 
+	    /* Or else, if the renamed object has an unconstrained type with
+	       default discriminant, use the padded type.  */
+	    else if (TYPE_IS_PADDING_P (TREE_TYPE (gnu_expr))
+		     && TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_expr)))
+			== gnu_type
+		     && CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type)))
+	      gnu_type = TREE_TYPE (gnu_expr);
+
 	    /* Case 1: If this is a constant renaming stemming from a function
 	       call, treat it as a normal object whose initial value is what
 	       is being renamed.  RM 3.3 says that the result of evaluating a

gcc/testsuite/ChangeLog

@@ -1,7 +1,17 @@
-2012-05-04  Eric Botcazou  <ebotcazou@adacore.com>
+2012-05-06  Eric Botcazou  <ebotcazou@adacore.com>
 
-	* gcc.target/ia64/pr48496.c: New test.
-	* gcc.target/ia64/pr52657.c: Likewise.
+	* gnat.dg/specs/renamings.ads: Rename to...
+	* gnat.dg/specs/renaming1.ads: ...this.
+	* gnat.dg/specs/renaming2.ads: New test.
+	* gnat.dg/specs/renaming2_pkg1.ads: New helper.
+	* gnat.dg/specs/renaming2_pkg2.ads: Likewise.
+	* gnat.dg/specs/renaming2_pkg3.ads: Likewise.
+	* gnat.dg/specs/renaming2_pkg4.ad[sb]: Likewise.
+
+2012-05-06  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gnat.dg/discr36.ad[sb]: New test.
+	* gnat.dg/discr36_pkg.ad[sb]: New helper.
 
 2012-05-05  Manuel López-Ibáñez  <manu@gcc.gnu.org>
 

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

@@ -1,4 +1,6 @@
-package Renamings is
+-- { dg-do compile }
+
+package Renaming1 is
 
    package Inner is
       procedure PI (X : Integer);
@@ -11,4 +13,4 @@ package Renamings is
    procedure Q (X : Float);
    procedure Q (X : Integer) renames Inner.PI;
    pragma Convention (C, Q); -- { dg-error "non-local entity" }
-end Renamings;
+end Renaming1;

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

@@ -0,0 +1,11 @@
+-- { dg-do compile }
+
+with Renaming2_Pkg1;
+
+package Renaming2 is
+
+  type T is null record;
+
+  package Iter is new Renaming2_Pkg1.GP.Inner (T);
+
+end Renaming2;

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

@@ -0,0 +1,17 @@
+-- { dg-excess-errors "no code generated" }
+
+with Renaming2_Pkg2;
+with Renaming2_Pkg3;
+with Renaming2_Pkg4;
+
+package Renaming2_Pkg1 is
+
+  package Impl is new
+    Renaming2_Pkg3 (Base_Index_T => Positive, Value_T => Renaming2_Pkg2.Root);
+
+  use Impl;
+
+  package GP is new
+    Renaming2_Pkg4 (Length_T => Impl.Length_T, Value_T => Renaming2_Pkg2.Root);
+
+end Renaming2_Pkg1;

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

@@ -0,0 +1,14 @@
+package Renaming2_Pkg2 is
+
+  type Root is private;
+
+private
+
+  type Root (D : Boolean := False) is record
+    case D is
+      when True => N : Natural;
+      when False => null;
+    end case;
+  end record;
+
+end Renaming2_Pkg2;

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

@@ -0,0 +1,25 @@
+-- { dg-excess-errors "no code generated" }
+
+generic
+
+  type Base_Index_T is range <>;
+
+  type Value_T is private;
+
+package Renaming2_Pkg3 is
+
+  type T is private;
+
+  subtype Length_T is Base_Index_T range 0 .. Base_Index_T'Last;
+
+  function Value (L : Length_T) return Value_T;
+
+  function Next return Length_T;
+
+private
+
+  type Obj_T is null record;
+
+  type T is access Obj_T;
+
+end Renaming2_Pkg3;

gcc/testsuite/gnat.dg/specs/renaming2_pkg4.adb

@@ -0,0 +1,12 @@
+package body Renaming2_Pkg4 is
+
+  package body Inner is
+
+      function Next_Value return Value_T is
+        Next_Value : Value_T renames Value (Next);
+      begin
+        return Next_Value;
+      end Next_Value;
+
+  end Inner;
+end Renaming2_Pkg4;

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

@@ -0,0 +1,25 @@
+-- { dg-excess-errors "no code generated" }
+
+generic
+
+  type Length_T is range <>;
+
+  with function Next return Length_T is <>;
+
+  type Value_T is private;
+
+  with function Value (L : Length_T) return Value_T is <>;
+
+package Renaming2_Pkg4 is
+
+  generic
+    type T is private;
+  package Inner is
+
+    type Slave_T is tagged null record;
+
+    function Next_Value return Value_T;
+
+  end Inner;
+
+end Renaming2_Pkg4;