[Ada] Fix ICE on new limited_with use in Ada 2012

[Eric Botcazou]

Ada 2012 has extended the use of limited_with and incomplete types coming from 
a limited context may now appear in parameter and result profiles.  This of 
course introduces more circularities, especially in -gnatct mode.

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


2012-10-22  Eric Botcazou  <ebotca...@adacore.com>

        * gcc-interface/decl.c (gnat_to_gnu_entity) <E_Subprogram_Type>: In
        type annotation mode, break circularities introduced by AI05-0151.


2012-10-22  Eric Botcazou  <ebotca...@adacore.com>

        * gnat.dg/specs/limited_with4.ads: New test.
        * gnat.dg/specs/limited_with4_pkg.ads: New helper.


-- 
Eric Botcazou
Index: gcc-interface/decl.c
===================================================================
--- gcc-interface/decl.c	(revision 192667)
+++ gcc-interface/decl.c	(working copy)
@@ -4142,7 +4142,18 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
 	  gnu_return_type = void_type_node;
 	else
 	  {
-	    gnu_return_type = gnat_to_gnu_type (gnat_return_type);
+	    /* Ada 2012 (AI05-0151): Incomplete types coming from a limited
+	       context may now appear in parameter and result profiles.  If
+	       we are only annotating types, break circularities here.  */
+	    if (type_annotate_only
+		&& IN (Ekind (gnat_return_type), Incomplete_Kind)
+	        && From_With_Type (gnat_return_type)
+		&& In_Extended_Main_Code_Unit
+		   (Non_Limited_View (gnat_return_type))
+		&& !present_gnu_tree (Non_Limited_View (gnat_return_type)))
+	      gnu_return_type = ptr_void_type_node;
+	    else
+	      gnu_return_type = gnat_to_gnu_type (gnat_return_type);
 
 	    /* If this function returns by reference, make the actual return
 	       type the pointer type and make a note of that.  */
@@ -4238,11 +4249,30 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
 	     Present (gnat_param);
 	     gnat_param = Next_Formal_With_Extras (gnat_param), parmnum++)
 	  {
+	    Entity_Id gnat_param_type = Etype (gnat_param);
 	    tree gnu_param_name = get_entity_name (gnat_param);
-	    tree gnu_param_type = gnat_to_gnu_type (Etype (gnat_param));
-	    tree gnu_param, gnu_field;
-	    bool copy_in_copy_out = false;
+	    tree gnu_param_type, gnu_param, gnu_field;
 	    Mechanism_Type mech = Mechanism (gnat_param);
+  	    bool copy_in_copy_out = false, fake_param_type;
+
+	    /* Ada 2012 (AI05-0151): Incomplete types coming from a limited
+	       context may now appear in parameter and result profiles.  If
+	       we are only annotating types, break circularities here.  */
+	    if (type_annotate_only
+		&& IN (Ekind (gnat_param_type), Incomplete_Kind)
+	        && From_With_Type (Etype (gnat_param_type))
+		&& In_Extended_Main_Code_Unit
+		   (Non_Limited_View (gnat_param_type))
+		&& !present_gnu_tree (Non_Limited_View (gnat_param_type)))
+	      {
+		gnu_param_type = ptr_void_type_node;
+		fake_param_type = true;
+	      }
+	    else
+	      {
+		gnu_param_type = gnat_to_gnu_type (gnat_param_type);
+		fake_param_type = false;
+	      }
 
 	    /* Builtins are expanded inline and there is no real call sequence
 	       involved.  So the type expected by the underlying expander is
@@ -4280,10 +4310,28 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
 		mech = Default;
 	      }
 
-	    gnu_param
-	      = gnat_to_gnu_param (gnat_param, mech, gnat_entity,
-				   Has_Foreign_Convention (gnat_entity),
-				   &copy_in_copy_out);
+	    /* Do not call gnat_to_gnu_param for a fake parameter type since
+	       it will try to use the real type again.  */
+	    if (fake_param_type)
+	      {
+		if (Ekind (gnat_param) == E_Out_Parameter)
+		  gnu_param = NULL_TREE;
+		else
+		  {
+		    gnu_param
+		      = create_param_decl (gnu_param_name, gnu_param_type,
+					   false);
+		    Set_Mechanism (gnat_param,
+				   mech == Default ? By_Copy : mech);
+		    if (Ekind (gnat_param) == E_In_Out_Parameter)
+		      copy_in_copy_out = true;
+		  }
+	      }
+	    else
+	      gnu_param
+		= gnat_to_gnu_param (gnat_param, mech, gnat_entity,
+				     Has_Foreign_Convention (gnat_entity),
+				     &copy_in_copy_out);
 
 	    /* We are returned either a PARM_DECL or a type if no parameter
 	       needs to be passed; in either case, adjust the type.  */
-- { dg-do compile }
-- { dg-options "-gnat12 -gnatct" }

with Ada.Containers.Vectors;
with Limited_With4_Pkg;

package Limited_With4 is

   type Object is tagged private;
   type Object_Ref is access all Object;
   type Class_Ref is access all Object'Class;

   package Vec is new Ada.Containers.Vectors
     (Positive, Limited_With4_Pkg.Object_Ref,Limited_With4_Pkg ."=");
   subtype Vector is Vec.Vector;

private

   type Object is tagged record
      V : Vector;
   end record;

end Limited_With4;

-- { dg-do compile }
-- { dg-options "-gnat12 -gnatct" }

limited with Limited_With4;

package Limited_With4_Pkg is

   type Object is tagged null record;
   type Object_Ref is access all Object;
   type Class_Ref is access all Object'Class;

   function Func return Limited_With4.Class_Ref;
   procedure Proc (Arg : Limited_With4.Class_Ref);

end Limited_With4_Pkg;