decl.c (gnat_to_gnu_entity): In type annotation mode, break circularities introduced...

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

From-SVN: r192671

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 5d39ca7f876b0800e362b1d41deb92a23e76f94c..db9eebcff2a63076a41d5953fa800ec0ea86766b 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,8 @@
+2012-10-22  Eric Botcazou  <ebotcazou@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  <ebotcazou@adacore.com>
 
        * gcc-interface/trans.c (Loop_Statement_to_gnu): Use gnat_type_for_size

diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index cb40ee68d509c82713e2408e5048bdd9971663c9..3e0d733248797d1b4a7558f6ca967fd3f0df4342 100644 (file)
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -4142,7 +4142,18 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
          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_entity, tree gnu_expr, int definition)
             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_entity, tree gnu_expr, int definition)
                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.  */

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index dbe23bf7cd7e86cd6d78be0435e847e8e3aa441d..2d514d2b41a1ab268215ba02fecb4beb5c39b670 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2012-10-22  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gnat.dg/specs/limited_with4.ads: New test.
+       * gnat.dg/specs/limited_with4_pkg.ads: New helper.
+
 2012-10-22  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gnat.dg/modular4.adb: New test.

diff --git a/gcc/testsuite/gnat.dg/specs/limited_with4.ads b/gcc/testsuite/gnat.dg/specs/limited_with4.ads
new file mode 100644 (file)
index 0000000..e182571
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/specs/limited_with4.ads
@@ -0,0 +1,23 @@
+-- { 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;

diff --git a/gcc/testsuite/gnat.dg/specs/limited_with4_pkg.ads b/gcc/testsuite/gnat.dg/specs/limited_with4_pkg.ads
new file mode 100644 (file)
index 0000000..f69ab47
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/specs/limited_with4_pkg.ads
@@ -0,0 +1,15 @@
+-- { 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;