diff options
-rw-r--r-- | gcc/ada/ChangeLog | 5 | ||||
-rw-r--r-- | gcc/ada/gcc-interface/decl.c | 64 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/specs/limited_with4.ads | 23 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/specs/limited_with4_pkg.ads | 15 |
5 files changed, 104 insertions, 8 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 5d39ca7..db9eebc 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,10 @@ 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 directly to obtain an unsigned version of the base type. diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index cb40ee6..3e0d733 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 dbe23bf..2d514d2 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,5 +1,10 @@ 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. * gnat.dg/modular4_pkg.ads: New helper. 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 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 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; |