Commit 25eb3455 by Eric Botcazou Committed by Eric Botcazou

decl.c (gnat_to_gnu_entity): In type annotation mode, break circularities introduced by AI05-0151.

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

From-SVN: r192671
parent 00a22e5e
2012-10-22 Eric Botcazou <ebotcazou@adacore.com> 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 * gcc-interface/trans.c (Loop_Statement_to_gnu): Use gnat_type_for_size
directly to obtain an unsigned version of the base type. directly to obtain an unsigned version of the base type.
......
...@@ -4142,7 +4142,18 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -4142,7 +4142,18 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
gnu_return_type = void_type_node; gnu_return_type = void_type_node;
else 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 /* If this function returns by reference, make the actual return
type the pointer type and make a note of that. */ 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) ...@@ -4238,11 +4249,30 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
Present (gnat_param); Present (gnat_param);
gnat_param = Next_Formal_With_Extras (gnat_param), parmnum++) 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_name = get_entity_name (gnat_param);
tree gnu_param_type = gnat_to_gnu_type (Etype (gnat_param)); tree gnu_param_type, gnu_param, gnu_field;
tree gnu_param, gnu_field;
bool copy_in_copy_out = false;
Mechanism_Type mech = Mechanism (gnat_param); 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 /* Builtins are expanded inline and there is no real call sequence
involved. So the type expected by the underlying expander is 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) ...@@ -4280,10 +4310,28 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
mech = Default; mech = Default;
} }
gnu_param /* Do not call gnat_to_gnu_param for a fake parameter type since
= gnat_to_gnu_param (gnat_param, mech, gnat_entity, it will try to use the real type again. */
Has_Foreign_Convention (gnat_entity), if (fake_param_type)
&copy_in_copy_out); {
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 /* We are returned either a PARM_DECL or a type if no parameter
needs to be passed; in either case, adjust the type. */ needs to be passed; in either case, adjust the type. */
......
2012-10-22 Eric Botcazou <ebotcazou@adacore.com> 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.adb: New test.
* gnat.dg/modular4_pkg.ads: New helper. * gnat.dg/modular4_pkg.ads: New helper.
......
-- { 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;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment