This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[Ada] Fix ICE on type completed by private type in Ada 2012


In Ada 2012, you can complete an incomplete type with a private type, so you 
can have 3 different views for a single type.  As the attached testcase shows,
this can lead to an ICE when the completion is a tagged private type because 
the full view is elaborated prematurely.

Tested on x86_64-suse-linux, applied on the mainline.


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>

	* gnat.dg/incomplete3.ad[sb]: New test.


-- 
Eric Botcazou
Index: gcc-interface/decl.c
===================================================================
--- gcc-interface/decl.c	(revision 199335)
+++ gcc-interface/decl.c	(working copy)
@@ -288,7 +288,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
      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_entit
       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: gcc-interface/trans.c
===================================================================
--- gcc-interface/trans.c	(revision 199330)
+++ gcc-interface/trans.c	(working copy)
@@ -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);
-- { 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;
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;

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]