From: Eric Botcazou Date: Mon, 22 Oct 2012 08:42:34 +0000 (+0000) Subject: decl.c (gnat_to_gnu_entity): In type annotation mode, break circularities introduced... X-Git-Tag: misc/gccgo-go1_1_2~55 X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=25eb3455aeec24f5084fd68f92287fba1d1c1718;p=thirdparty%2Fgcc.git decl.c (gnat_to_gnu_entity): In type annotation mode, break circularities introduced by AI05-0151. * gcc-interface/decl.c (gnat_to_gnu_entity) : In type annotation mode, break circularities introduced by AI05-0151. From-SVN: r192671 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 5d39ca7f876b..db9eebcff2a6 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2012-10-22 Eric Botcazou + + * gcc-interface/decl.c (gnat_to_gnu_entity) : In + type annotation mode, break circularities introduced by AI05-0151. + 2012-10-22 Eric Botcazou * 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 cb40ee68d509..3e0d73324879 100644 --- 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), - ©_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), + ©_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 dbe23bf7cd7e..2d514d2b41a1 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2012-10-22 Eric Botcazou + + * gnat.dg/specs/limited_with4.ads: New test. + * gnat.dg/specs/limited_with4_pkg.ads: New helper. + 2012-10-22 Eric Botcazou * 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 index 000000000000..e182571f3359 --- /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 index 000000000000..f69ab47bab9b --- /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;