decl.c (gnat_to_gnu_entity): Do not prematurely elaborate the full view of a type with a freeze node.

	* gcc-interface/decl.c (gnat_to_gnu_entity): Do not prematurely
	elaborate the full view of a type with a freeze node.
	* gcc-interface/trans.c (process_type): Add explicit predicate.

From-SVN: r199336

6 files changed, 53 insertions, 3 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 7c42173..2844de4 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,11 @@
 2013-05-26  Eric Botcazou  <ebotcazou@adacore.com>
 
+	* gcc-interface/decl.c (gnat_to_gnu_entity): Do not prematurely
+	elaborate the full view of a type with a freeze node.
+	* gcc-interface/trans.c (process_type): Add explicit predicate.
+
+2013-05-26  Eric Botcazou  <ebotcazou@adacore.com>
+
 	* gcc-interface/decl.c (gnat_to_gnu_entity) <object>: Always build the
 	UNC variable for aliased objects with unconstrained nominal subtype.
 
diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index bf334da..4a528b2 100644
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -288,7 +288,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
      If we are defining the node, we should not have already processed it.
      In that case, we will abort below when we try to save a new GCC tree
      for this object.  We also need to handle the case of getting a dummy
-     type when a Full_View exists.  */
+     type when a Full_View exists but be careful so as not to trigger its
+     premature elaboration.  */
   if ((!definition || (is_type && imported_p))
       && present_gnu_tree (gnat_entity))
     {
@@ -297,7 +298,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
       if (TREE_CODE (gnu_decl) == TYPE_DECL
 	  && TYPE_IS_DUMMY_P (TREE_TYPE (gnu_decl))
 	  && IN (kind, Incomplete_Or_Private_Kind)
-	  && Present (Full_View (gnat_entity)))
+	  && Present (Full_View (gnat_entity))
+	  && (present_gnu_tree (Full_View (gnat_entity))
+	      || No (Freeze_Node (Full_View (gnat_entity)))))
 	{
 	  gnu_decl
 	    = gnat_to_gnu_entity (Full_View (gnat_entity), NULL_TREE, 0);
diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index 6c9407e..13767e9 100644
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -8723,7 +8723,7 @@ process_type (Entity_Id gnat_entity)
   if (Present (Freeze_Node (gnat_entity))
       || (IN (Ekind (gnat_entity), Incomplete_Or_Private_Kind)
 	  && Present (Full_View (gnat_entity))
-	  && Freeze_Node (Full_View (gnat_entity))
+	  && Present (Freeze_Node (Full_View (gnat_entity)))
 	  && !present_gnu_tree (Full_View (gnat_entity))))
     {
       elaborate_entity (gnat_entity);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 38985d6..f60cfe1 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2013-05-26  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gnat.dg/incomplete3.ad[sb]: New test.
+
 2013-05-25  Richard Sandiford  <rdsandiford@googlemail.com>
 
 	PR target/53916
diff --git a/gcc/testsuite/gnat.dg/incomplete3.adb b/gcc/testsuite/gnat.dg/incomplete3.adb
new file mode 100644
index 0000000..6db500f
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/incomplete3.adb
@@ -0,0 +1,15 @@
+-- { dg-do compile }
+
+package body Incomplete3 is
+
+   function Get_Tracer (This : access Output_T'Class) return Tracer_T'class is
+   begin
+      return Tracer_T'Class (Tracer_T'(Output => This));
+   end ;
+
+   function Get_Output (This : in Tracer_T) return access Output_T'Class is
+   begin
+      return This.Output;
+   end;
+
+end Incomplete3;
diff --git a/gcc/testsuite/gnat.dg/incomplete3.ads b/gcc/testsuite/gnat.dg/incomplete3.ads
new file mode 100644
index 0000000..6f89374
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/incomplete3.ads
@@ -0,0 +1,22 @@
+package Incomplete3 is
+
+   type Output_T;
+   type Output_T is abstract tagged private;
+
+   type Tracer_T is tagged private;
+
+   function Get_Tracer (This : access Output_T'Class) return Tracer_T'class;
+
+   function Get_Output (This : in Tracer_T) return access Output_T'Class;
+
+private
+
+   type Output_T is abstract tagged record
+      B : Boolean := True;
+   end record;
+
+   type Tracer_T is tagged record
+      Output : access Output_T'Class := null;
+   end record;
+
+end Incomplete3;