gigi.h (finalize_from_with_types): Adjust comment.

* gcc-interface/gigi.h (finalize_from_with_types): Adjust comment.
	* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Access_Type>: Defer
	unconditionally to the end of the unit when the designated type is
	limited_with'ed.
	<all>: Rename local variable.  Attempt to un-defer types only and do it
	for limited_with'ed types as well.
	(finalize_from_with_types): Adjust comment.  Rename variable and tidy.
	* gcc-interface/trans.c (Compilation_Unit_to_gnu): Use GNAT_UNIT
	consistently and remove redundant call to finalize_from_with_types.

From-SVN: r171552
This commit is contained in:
Eric Botcazou 2011-03-26 09:55:04 +00:00 committed by Eric Botcazou
parent 5daed84a54
commit 6ddf984362
9 changed files with 106 additions and 50 deletions

View File

@ -1,3 +1,15 @@
2011-03-26 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/gigi.h (finalize_from_with_types): Adjust comment.
* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Access_Type>: Defer
unconditionally to the end of the unit when the designated type is
limited_with'ed.
<all>: Rename local variable. Attempt to un-defer types only and do it
for limited_with'ed types as well.
(finalize_from_with_types): Adjust comment. Rename variable and tidy.
* gcc-interface/trans.c (Compilation_Unit_to_gnu): Use GNAT_UNIT
consistently and remove redundant call to finalize_from_with_types.
2011-03-26 Eric Botcazou <ebotcazou@adacore.com> 2011-03-26 Eric Botcazou <ebotcazou@adacore.com>
* inline.adb (Back_End_Cannot_Inline): Lift restriction on calls to * inline.adb (Back_End_Cannot_Inline): Lift restriction on calls to

View File

@ -3723,15 +3723,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
save our current definition, evaluate the actual type, and replace save our current definition, evaluate the actual type, and replace
the tentative type we made with the actual one. If we are to defer the tentative type we made with the actual one. If we are to defer
actually looking up the actual type, make an entry in the deferred actually looking up the actual type, make an entry in the deferred
list. If this is from a limited with, we have to defer to the end list. If this is from a limited with, we may have to defer to the
of the current spec in two cases: first if the designated type is end of the current unit. */
in the current unit and second if the access type itself is. */
if ((!in_main_unit || is_from_limited_with) && made_dummy) if ((!in_main_unit || is_from_limited_with) && made_dummy)
{ {
bool is_from_limited_with_in_main_unit
= (is_from_limited_with
&& (in_main_unit
|| In_Extended_Main_Code_Unit (gnat_entity)));
tree gnu_old_desig_type tree gnu_old_desig_type
= TYPE_IS_FAT_POINTER_P (gnu_type) = TYPE_IS_FAT_POINTER_P (gnu_type)
? TYPE_UNCONSTRAINED_ARRAY (gnu_type) : TREE_TYPE (gnu_type); ? TYPE_UNCONSTRAINED_ARRAY (gnu_type) : TREE_TYPE (gnu_type);
@ -3762,15 +3757,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
Besides, variants of this non-dummy type might have been created Besides, variants of this non-dummy type might have been created
along the way. update_pointer_to is expected to properly take along the way. update_pointer_to is expected to properly take
care of those situations. */ care of those situations. */
if (defer_incomplete_level == 0 if (defer_incomplete_level == 0 && !is_from_limited_with)
&& !is_from_limited_with_in_main_unit)
update_pointer_to (TYPE_MAIN_VARIANT (gnu_old_desig_type), update_pointer_to (TYPE_MAIN_VARIANT (gnu_old_desig_type),
gnat_to_gnu_type (gnat_desig_equiv)); gnat_to_gnu_type (gnat_desig_equiv));
else else
{ {
struct incomplete *p = XNEW (struct incomplete); struct incomplete *p = XNEW (struct incomplete);
struct incomplete **head struct incomplete **head
= (is_from_limited_with_in_main_unit = (is_from_limited_with
? &defer_limited_with : &defer_incomplete_list); ? &defer_limited_with : &defer_incomplete_list);
p->old_type = gnu_old_desig_type; p->old_type = gnu_old_desig_type;
p->full_type = gnat_desig_equiv; p->full_type = gnat_desig_equiv;
@ -4968,12 +4962,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
{ {
if (defer_incomplete_list) if (defer_incomplete_list)
{ {
struct incomplete *incp, *next; struct incomplete *p, *next;
/* We are back to level 0 for the deferring of incomplete types. /* We are back to level 0 for the deferring of incomplete types.
But processing these incomplete types below may itself require But processing these incomplete types below may itself require
deferring, so preserve what we have and restart from scratch. */ deferring, so preserve what we have and restart from scratch. */
incp = defer_incomplete_list; p = defer_incomplete_list;
defer_incomplete_list = NULL; defer_incomplete_list = NULL;
/* For finalization, however, all types must be complete so we /* For finalization, however, all types must be complete so we
@ -4981,14 +4975,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
referencing each other. Process them all recursively first. */ referencing each other. Process them all recursively first. */
defer_finalize_level++; defer_finalize_level++;
for (; incp; incp = next) for (; p; p = next)
{ {
next = incp->next; next = p->next;
if (incp->old_type) if (p->old_type)
update_pointer_to (TYPE_MAIN_VARIANT (incp->old_type), update_pointer_to (TYPE_MAIN_VARIANT (p->old_type),
gnat_to_gnu_type (incp->full_type)); gnat_to_gnu_type (p->full_type));
free (incp); free (p);
} }
defer_finalize_level--; defer_finalize_level--;
@ -5008,18 +5002,26 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
} }
} }
/* If we are not defining this type, see if it's in the incomplete list. /* If we are not defining this type, see if it's on one of the lists of
If so, handle that list entry now. */ incomplete types. If so, handle the list entry now. */
else if (!definition) if (is_type && !definition)
{ {
struct incomplete *incp; struct incomplete *p;
for (incp = defer_incomplete_list; incp; incp = incp->next) for (p = defer_incomplete_list; p; p = p->next)
if (incp->old_type && incp->full_type == gnat_entity) if (p->old_type && p->full_type == gnat_entity)
{ {
update_pointer_to (TYPE_MAIN_VARIANT (incp->old_type), update_pointer_to (TYPE_MAIN_VARIANT (p->old_type),
TREE_TYPE (gnu_decl)); TREE_TYPE (gnu_decl));
incp->old_type = NULL_TREE; p->old_type = NULL_TREE;
}
for (p = defer_limited_with; p; p = p->next)
if (p->old_type && Non_Limited_View (p->full_type) == gnat_entity)
{
update_pointer_to (TYPE_MAIN_VARIANT (p->old_type),
TREE_TYPE (gnu_decl));
p->old_type = NULL_TREE;
} }
} }
@ -5144,24 +5146,24 @@ finish_fat_pointer_type (tree record_type, tree field_list)
TYPE_CONTAINS_PLACEHOLDER_INTERNAL (record_type) = 2; TYPE_CONTAINS_PLACEHOLDER_INTERNAL (record_type) = 2;
} }
/* Finalize any From_With_Type incomplete types. We do this after processing /* Finalize the processing of From_With_Type incomplete types. */
our compilation unit and after processing its spec, if this is a body. */
void void
finalize_from_with_types (void) finalize_from_with_types (void)
{ {
struct incomplete *incp = defer_limited_with; struct incomplete *p, *next;
struct incomplete *next;
defer_limited_with = 0; p = defer_limited_with;
for (; incp; incp = next) defer_limited_with = NULL;
for (; p; p = next)
{ {
next = incp->next; next = p->next;
if (incp->old_type != 0) if (p->old_type)
update_pointer_to (TYPE_MAIN_VARIANT (incp->old_type), update_pointer_to (TYPE_MAIN_VARIANT (p->old_type),
gnat_to_gnu_type (incp->full_type)); gnat_to_gnu_type (p->full_type));
free (incp); free (p);
} }
} }

View File

@ -96,8 +96,7 @@ do { \
mark_visited (EXP); \ mark_visited (EXP); \
} while (0) } while (0)
/* Finalize any From_With_Type incomplete types. We do this after processing /* Finalize the processing of From_With_Type incomplete types. */
our compilation unit and after processing its spec, if this is a body. */
extern void finalize_from_with_types (void); extern void finalize_from_with_types (void);
/* Return the equivalent type to be used for GNAT_ENTITY, if it's a /* Return the equivalent type to be used for GNAT_ENTITY, if it's a

View File

@ -3785,27 +3785,23 @@ Compilation_Unit_to_gnu (Node_Id gnat_node)
gnat_pushlevel (); gnat_pushlevel ();
/* For a body, first process the spec if there is one. */ /* For a body, first process the spec if there is one. */
if (Nkind (Unit (gnat_node)) == N_Package_Body if (Nkind (gnat_unit) == N_Package_Body
|| (Nkind (Unit (gnat_node)) == N_Subprogram_Body || (Nkind (gnat_unit) == N_Subprogram_Body && !Acts_As_Spec (gnat_node)))
&& !Acts_As_Spec (gnat_node))) add_stmt (gnat_to_gnu (Library_Unit (gnat_node)));
{
add_stmt (gnat_to_gnu (Library_Unit (gnat_node)));
finalize_from_with_types ();
}
if (type_annotate_only && gnat_node == Cunit (Main_Unit)) if (type_annotate_only && gnat_node == Cunit (Main_Unit))
{ {
elaborate_all_entities (gnat_node); elaborate_all_entities (gnat_node);
if (Nkind (Unit (gnat_node)) == N_Subprogram_Declaration if (Nkind (gnat_unit) == N_Subprogram_Declaration
|| Nkind (Unit (gnat_node)) == N_Generic_Package_Declaration || Nkind (gnat_unit) == N_Generic_Package_Declaration
|| Nkind (Unit (gnat_node)) == N_Generic_Subprogram_Declaration) || Nkind (gnat_unit) == N_Generic_Subprogram_Declaration)
return; return;
} }
process_decls (Declarations (Aux_Decls_Node (gnat_node)), Empty, Empty, process_decls (Declarations (Aux_Decls_Node (gnat_node)), Empty, Empty,
true, true); true, true);
add_stmt (gnat_to_gnu (Unit (gnat_node))); add_stmt (gnat_to_gnu (gnat_unit));
/* If we can inline, generate code for all the inlined subprograms. */ /* If we can inline, generate code for all the inlined subprograms. */
if (optimize) if (optimize)

View File

@ -1,3 +1,9 @@
2011-03-26 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/limited_with2.ad[sb]: New test.
* gnat.dg/limited_with2_pkg1.ads: New helper.
* gnat.dg/imited_with2_pkg2.ads: Likewise.
2011-03-26 Eric Botcazou <ebotcazou@adacore.com> 2011-03-26 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/opt15.adb: New test. * gnat.dg/opt15.adb: New test.

View File

@ -0,0 +1,12 @@
-- { dg-do compile }
with Limited_With2_Pkg2;
package body Limited_With2 is
function Func (Val : Rec1) return Limited_With2_Pkg1.Rec2 is
begin
return Val.F;
end;
end Limited_With2;

View File

@ -0,0 +1,11 @@
with Limited_With2_Pkg1;
package Limited_With2 is
type Rec1 is record
F : Limited_With2_Pkg1.Rec2;
end record;
function Func (Val : Rec1) return Limited_With2_Pkg1.Rec2;
end Limited_With2;

View File

@ -0,0 +1,9 @@
limited with Limited_With2_Pkg2;
package Limited_With2_Pkg1 is
type Rec2 is record
F : access Limited_With2_Pkg2.Rec3;
end record;
end Limited_With2_Pkg1;

View File

@ -0,0 +1,9 @@
with Limited_With2;
package Limited_With2_Pkg2 is
type Rec3 is record
F : Limited_With2.Rec1;
end record;
end Limited_With2_Pkg2;