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

	* 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 1ea386b..6587ffd 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,10 @@
 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.
        (gnat_write_global_declarations): Output debug information for all
        global type declarations before finalizing the compilation unit.

diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index 5f08877..ca47e93 100644 (file)
--- 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 749949f..131da5e 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,10 @@
 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...
        * gnat.dg/taft_type1.adb: ...this.
        * gnat.dg/tamdt.ad[sb]: Rename to...

diff --git a/gcc/testsuite/gnat.dg/deferred_const4.adb b/gcc/testsuite/gnat.dg/deferred_const4.adb
new file mode 100644 (file)
index 0000000..46f2110
--- /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 (file)
index 0000000..18a4171
--- /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 (file)
index 0000000..c189063
--- /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;