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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 803e97be8695c80a3d09ae9a2bc1f46ff6e26536..856d100e8b0bf9794a12097924063ddba5a580e9 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/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>

diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index ee96dbe454528194dfb6d64fe7f169558f22ddde..97ade5e6159028e987cb90f6f966182af76dc5dd 100644 (file)
--- a/gcc/ada/gcc-interface/decl.c
+++ b/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

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 8a988c1173adddb6c398c8c9a34ae3e0d45ade04..20133aa4cbd472fee2204fc0ae38e1dea4113e54 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/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>
 

diff --git a/gcc/testsuite/gnat.dg/specs/renamings.ads b/gcc/testsuite/gnat.dg/specs/renaming1.ads
similarity index 85%
rename from gcc/testsuite/gnat.dg/specs/renamings.ads
rename to gcc/testsuite/gnat.dg/specs/renaming1.ads
index 74579529980c4d8e668b8a903316f2fcfec67973..b97605aa7d25e639686eebe64003a3c9479f63e6 100644 (file)
--- a/gcc/testsuite/gnat.dg/specs/renamings.ads
+++ b/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;

diff --git a/gcc/testsuite/gnat.dg/specs/renaming2.ads b/gcc/testsuite/gnat.dg/specs/renaming2.ads
new file mode 100644 (file)
index 0000000..5f199c6
--- /dev/null
+++ b/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;

diff --git a/gcc/testsuite/gnat.dg/specs/renaming2_pkg1.ads b/gcc/testsuite/gnat.dg/specs/renaming2_pkg1.ads
new file mode 100644 (file)
index 0000000..45d5436
--- /dev/null
+++ b/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;

diff --git a/gcc/testsuite/gnat.dg/specs/renaming2_pkg2.ads b/gcc/testsuite/gnat.dg/specs/renaming2_pkg2.ads
new file mode 100644 (file)
index 0000000..38e0189
--- /dev/null
+++ b/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;

diff --git a/gcc/testsuite/gnat.dg/specs/renaming2_pkg3.ads b/gcc/testsuite/gnat.dg/specs/renaming2_pkg3.ads
new file mode 100644 (file)
index 0000000..93ec0df
--- /dev/null
+++ b/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;

diff --git a/gcc/testsuite/gnat.dg/specs/renaming2_pkg4.adb b/gcc/testsuite/gnat.dg/specs/renaming2_pkg4.adb
new file mode 100644 (file)
index 0000000..50dd536
--- /dev/null
+++ b/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;

diff --git a/gcc/testsuite/gnat.dg/specs/renaming2_pkg4.ads b/gcc/testsuite/gnat.dg/specs/renaming2_pkg4.ads
new file mode 100644 (file)
index 0000000..abeffcc
--- /dev/null
+++ b/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;