From: Eric Botcazou <ebotcazou@adacore.com>
Date: Mon, 6 Jun 2011 10:21:58 +0000 (+0000)
Subject: trans.c (Identifier_to_gnu): Also handle deferred constants whose full view has discr... 
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=e9f57686fcfaf04788a27d6433e7bf727d08001c;p=gcc.git

trans.c (Identifier_to_gnu): Also handle deferred constants whose full view has discriminants specially.

	* gcc-interface/trans.c (Identifier_to_gnu): Also handle deferred
	constants whose full view has discriminants specially.

From-SVN: r174689
---

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 1ea386b3912..6587ffd9a0b 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,8 @@
+2011-06-06  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gcc-interface/trans.c (Identifier_to_gnu): Also handle deferred
+	constants whose full view has discriminants specially.
+
 2011-06-06  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* gcc-interface/utils.c: Include diagnostic.h.
diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index 5f08877709f..ca47e9347de 100644
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -906,9 +906,11 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
      attribute Position, generated for dispatching code (see Make_DT in
      exp_disp,adb). In that case we need the type itself, not is parent,
      in particular if it is a derived type  */
-  if (Is_Private_Type (gnat_temp_type)
-      && Has_Unknown_Discriminants (gnat_temp_type)
-      && Ekind (gnat_temp) == E_Constant
+  if (Ekind (gnat_temp) == E_Constant
+      && Is_Private_Type (gnat_temp_type)
+      && (Has_Unknown_Discriminants (gnat_temp_type)
+	  || (Present (Full_View (gnat_temp_type))
+ 	      && Has_Discriminants (Full_View (gnat_temp_type))))
       && Present (Full_View (gnat_temp)))
     {
       gnat_temp = Full_View (gnat_temp);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 749949f810f..131da5e7743 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2011-06-06  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gnat.dg/deferred_const4.ad[sb]: New test.
+	* gnat.dg/deferred_const4_pkg.ads: New helper.
+
 2011-06-06  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* gnat.dg/test_tamdt.adb: Rename to...
diff --git a/gcc/testsuite/gnat.dg/deferred_const4.adb b/gcc/testsuite/gnat.dg/deferred_const4.adb
new file mode 100644
index 00000000000..46f21103ae5
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/deferred_const4.adb
@@ -0,0 +1,12 @@
+-- { dg-do compile }
+
+package body Deferred_Const4 is
+
+  function F return My_Q.T is
+    R : My_Q.T;
+  begin
+    R := My_Q.Null_T;
+    return R;
+  end;
+
+end Deferred_Const4;
diff --git a/gcc/testsuite/gnat.dg/deferred_const4.ads b/gcc/testsuite/gnat.dg/deferred_const4.ads
new file mode 100644
index 00000000000..18a4171e8b2
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/deferred_const4.ads
@@ -0,0 +1,17 @@
+with Deferred_Const4_Pkg;
+
+package Deferred_Const4 is
+
+  type R1 is tagged record
+    I1 : Integer;
+  end record;
+
+  type R2 is new R1 with record
+    I2 : Integer;
+  end record;
+
+  package My_Q is new Deferred_Const4_Pkg (R2);
+
+  function F return My_Q.T;
+
+end Deferred_Const4;
diff --git a/gcc/testsuite/gnat.dg/deferred_const4_pkg.ads b/gcc/testsuite/gnat.dg/deferred_const4_pkg.ads
new file mode 100644
index 00000000000..c189063a758
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/deferred_const4_pkg.ads
@@ -0,0 +1,22 @@
+generic
+
+  type User_T is private;
+
+package Deferred_Const4_Pkg is
+
+  type T is private;
+
+  Null_T : constant T;
+
+private
+
+  type T (Valid : Boolean := False) is record
+    case Valid is
+      when True  => Value : User_T;
+      when False => null;
+    end case;
+  end record;
+
+  Null_T : constant T := (Valid => False);
+
+end Deferred_Const4_Pkg;