decl.c (gnat_to_gnu_entity): Do not prematurely elaborate the full view of a type...
authorEric Botcazou <ebotcazou@adacore.com>
Sun, 26 May 2013 08:48:22 +0000 (08:48 +0000)
committerEric Botcazou <ebotcazou@gcc.gnu.org>
Sun, 26 May 2013 08:48:22 +0000 (08:48 +0000)
* 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

gcc/ada/ChangeLog
gcc/ada/gcc-interface/decl.c
gcc/ada/gcc-interface/trans.c
gcc/testsuite/ChangeLog
gcc/testsuite/gnat.dg/incomplete3.adb [new file with mode: 0644]
gcc/testsuite/gnat.dg/incomplete3.ads [new file with mode: 0644]

index 7c421738e4535539f2a246b343d4d069a4cf5284..2844de415ed00061c6a6a33a539776582e7b693b 100644 (file)
@@ -1,3 +1,9 @@
+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
index bf334da576145b1141c553ba4bf56f1672e47cb5..4a528b20d1d5423092ba035e0c3671ba446476bf 100644 (file)
@@ -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);
index 6c9407e4e3513290bd888b379ebcf5886d5ffcd5..13767e9dd9bc609a32c936d300b6dbe00cb10b69 100644 (file)
@@ -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);
index 38985d6119afdf89fdd2df24061e5f4571022666..f60cfe17b703a5f69145d0cdb8426e62d7d0df14 100644 (file)
@@ -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 (file)
index 0000000..6db500f
--- /dev/null
@@ -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 (file)
index 0000000..6f89374
--- /dev/null
@@ -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;