trans.c (Identifier_to_gnu): Move block retrieving the type of the result to the...

	* gcc-interface/trans.c (Identifier_to_gnu): Move block retrieving the
	type of the result to the end and execute it for a deferred constant of
	a discriminated type whose full view can be elaborated statically.

From-SVN: r184259

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 04a66c5..7c57446 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,11 @@
 2012-02-15  Eric Botcazou  <ebotcazou@adacore.com>
 
+       * gcc-interface/trans.c (Identifier_to_gnu): Move block retrieving the
+       type of the result to the end and execute it for a deferred constant of
+       a discriminated type whose full view can be elaborated statically.
+
+2012-02-15  Eric Botcazou  <ebotcazou@adacore.com>
+
        * gcc-interface/trans.c (gnat_to_gnu) <N_Qualified_Expression>: If the
        type is tagged, mark it as used for debugging purposes.
        <N_Allocator>: Likewise for a qualified expression.

diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index a99c967..52a5ea9 100644 (file)
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -1077,17 +1077,6 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
        }
     }
 
-  /* The GNAT tree has the type of a function as the type of its result.  Also
-     use the type of the result if the Etype is a subtype which is nominally
-     unconstrained.  But remove any padding from the resulting type.  */
-  if (TREE_CODE (TREE_TYPE (gnu_result)) == FUNCTION_TYPE
-      || Is_Constr_Subt_For_UN_Aliased (gnat_temp_type))
-    {
-      gnu_result_type = TREE_TYPE (gnu_result);
-      if (TYPE_IS_PADDING_P (gnu_result_type))
-       gnu_result_type = TREE_TYPE (TYPE_FIELDS (gnu_result_type));
-    }
-
   /* If we have a constant declaration and its initializer, try to return the
      latter to avoid the need to call fold in lots of places and the need for
      elaboration code if this identifier is used as an initializer itself.
@@ -1120,6 +1109,24 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
        gnu_result = unshare_expr (DECL_INITIAL (gnu_result));
     }
 
+  /* The GNAT tree has the type of a function set to its result type, so we
+     adjust here.  Also use the type of the result if the Etype is a subtype
+     that is nominally unconstrained.  Likewise if this is a deferred constant
+     of a discriminated type whose full view can be elaborated statically, to
+     avoid problematic conversions to the nominal subtype.  But remove any
+     padding from the resulting type.  */
+  if (TREE_CODE (TREE_TYPE (gnu_result)) == FUNCTION_TYPE
+      || Is_Constr_Subt_For_UN_Aliased (gnat_temp_type)
+      || (Ekind (gnat_temp) == E_Constant
+         && Present (Full_View (gnat_temp))
+         && Has_Discriminants (gnat_temp_type)
+         && TREE_CODE (gnu_result) == CONSTRUCTOR))
+    {
+      gnu_result_type = TREE_TYPE (gnu_result);
+      if (TYPE_IS_PADDING_P (gnu_result_type))
+       gnu_result_type = TREE_TYPE (TYPE_FIELDS (gnu_result_type));
+    }
+
   *gnu_result_type_p = gnu_result_type;
 
   return gnu_result;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index a90a6ae..6f53a28 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,6 +1,10 @@
 2012-02-15  Eric Botcazou  <ebotcazou@adacore.com>
 
-       * gnat.dg/volatile10.adb: New case.
+       * gnat.dg/discr35.ad[sb]: New test.
+
+2012-02-15  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gnat.dg/volatile10.adb: New test.
        * gnat.dg/volatile10_pkg.ads: New helper.
 
 2012-02-14  Jason Merrill  <jason@redhat.com>

diff --git a/gcc/testsuite/gnat.dg/discr35.adb b/gcc/testsuite/gnat.dg/discr35.adb
new file mode 100644 (file)
index 0000000..8b73773
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/discr35.adb
@@ -0,0 +1,17 @@
+-- { dg-do compile }\r
+\r
+package body Discr35 is\r
+\r
+   procedure Proc1 is\r
+     R : Rec2 := Null_Rec2;\r
+   begin\r
+     null;\r
+   end;\r
+\r
+   procedure Proc2 is\r
+     R : Rec2;\r
+   begin\r
+     R := Null_Rec2;\r
+   end;\r
+\r
+end Discr35;\r

diff --git a/gcc/testsuite/gnat.dg/discr35.ads b/gcc/testsuite/gnat.dg/discr35.ads
new file mode 100644 (file)
index 0000000..beb2c40
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/discr35.ads
@@ -0,0 +1,25 @@
+package Discr35 is\r
+\r
+  type Rec1 is tagged null record;\r
+\r
+  type Enum is (One, Two);\r
+\r
+  type Rec2 (D : Enum := One) is\r
+  record\r
+    case D is\r
+      when One => null;\r
+      when Two => R : Rec1;\r
+    end case;\r
+  end record;\r
+\r
+   Null_Rec2 : Constant Rec2;\r
+\r
+   procedure Proc1;\r
+\r
+   procedure Proc2;\r
+\r
+private\r
+\r
+   Null_Rec2 : Constant Rec2 := (D => One);\r
+\r
+end Discr35;\r