Commit 7fddde95 by Eric Botcazou Committed by Eric Botcazou

decl.c (gnat_to_gnu_entity): Beep up comment on SAVED...

	* gcc-interface/decl.c (gnat_to_gnu_entity): Beep up comment on SAVED,
	and tweak comment on the assertion about the scopes of Itypes.  Do not
	skip the regular processing for Itypes that are E_Record_Subtype with
	a Cloned_Subtype.  Get the Cloned_Subtype for every E_Record_Subtype
	if the type is dummy and hasn't got its own freeze node.
	<E_Record_Subtype>: Save again the DECL of the Cloned_Subtype, if any.
	<E_Access_Subtype>: Save again the DECL of the equivalent type.
	(Gigi_Equivalent_Type) <E_Access_Subtype>: New case.

From-SVN: r272822
parent db53aa5c
2019-06-29 Eric Botcazou <ebotcazou@adacore.com> 2019-06-29 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/decl.c (gnat_to_gnu_entity): Beep up comment on SAVED,
and tweak comment on the assertion about the scopes of Itypes. Do not
skip the regular processing for Itypes that are E_Record_Subtype with
a Cloned_Subtype. Get the Cloned_Subtype for every E_Record_Subtype
if the type is dummy and hasn't got its own freeze node.
<E_Record_Subtype>: Save again the DECL of the Cloned_Subtype, if any.
<E_Access_Subtype>: Save again the DECL of the equivalent type.
(Gigi_Equivalent_Type) <E_Access_Subtype>: New case.
2019-06-29 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/utils.c (unchecked_convert): Tweak comment. Only skip * gcc-interface/utils.c (unchecked_convert): Tweak comment. Only skip
dereferences when padding to have the same size on both sides. Do it dereferences when padding to have the same size on both sides. Do it
for destination types with self-referential size too. for destination types with self-referential size too.
......
...@@ -308,7 +308,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) ...@@ -308,7 +308,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
tree gnu_size = NULL_TREE; tree gnu_size = NULL_TREE;
/* Contains the GCC name to be used for the GCC node. */ /* Contains the GCC name to be used for the GCC node. */
tree gnu_entity_name; tree gnu_entity_name;
/* True if we have already saved gnu_decl as a GNAT association. */ /* True if we have already saved gnu_decl as a GNAT association. This can
also be used to purposely avoid making such an association but this use
case ought not to be applied to types because it can break the deferral
mechanism implemented for access types. */
bool saved = false; bool saved = false;
/* True if we incremented defer_incomplete_level. */ /* True if we incremented defer_incomplete_level. */
bool this_deferred = false; bool this_deferred = false;
...@@ -325,14 +328,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) ...@@ -325,14 +328,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
/* Since a use of an Itype is a definition, process it as such if it is in /* Since a use of an Itype is a definition, process it as such if it is in
the main unit, except for E_Access_Subtype because it's actually a use the main unit, except for E_Access_Subtype because it's actually a use
of its base type, and for E_Record_Subtype with cloned subtype because of its base type, see below. */
it's actually a use of the cloned subtype, see below. */
if (!definition if (!definition
&& is_type && is_type
&& Is_Itype (gnat_entity) && Is_Itype (gnat_entity)
&& !(kind == E_Access_Subtype && Ekind (gnat_entity) != E_Access_Subtype
|| (kind == E_Record_Subtype
&& Present (Cloned_Subtype (gnat_entity))))
&& !present_gnu_tree (gnat_entity) && !present_gnu_tree (gnat_entity)
&& In_Extended_Main_Code_Unit (gnat_entity)) && In_Extended_Main_Code_Unit (gnat_entity))
{ {
...@@ -375,7 +375,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) ...@@ -375,7 +375,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
} }
/* This abort means the Itype has an incorrect scope, i.e. that its /* This abort means the Itype has an incorrect scope, i.e. that its
scope does not correspond to the subprogram it is declared in. */ scope does not correspond to the subprogram it is first used in. */
gcc_unreachable (); gcc_unreachable ();
} }
...@@ -384,7 +384,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) ...@@ -384,7 +384,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
In that case, we will abort below when we try to save a new GCC tree In that case, we will abort below when we try to save a new GCC tree
for this object. We also need to handle the case of getting a dummy for this object. We also need to handle the case of getting a dummy
type when a Full_View exists but be careful so as not to trigger its type when a Full_View exists but be careful so as not to trigger its
premature elaboration. */ premature elaboration. Likewise for a cloned subtype without its own
freeze node, which typically happens when a generic gets instantiated
on an incomplete or private type. */
if ((!definition || (is_type && imported_p)) if ((!definition || (is_type && imported_p))
&& present_gnu_tree (gnat_entity)) && present_gnu_tree (gnat_entity))
{ {
...@@ -398,7 +400,23 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) ...@@ -398,7 +400,23 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
|| No (Freeze_Node (Full_View (gnat_entity))))) || No (Freeze_Node (Full_View (gnat_entity)))))
{ {
gnu_decl gnu_decl
= gnat_to_gnu_entity (Full_View (gnat_entity), NULL_TREE, false); = gnat_to_gnu_entity (Full_View (gnat_entity), NULL_TREE,
false);
save_gnu_tree (gnat_entity, NULL_TREE, false);
save_gnu_tree (gnat_entity, gnu_decl, false);
}
if (TREE_CODE (gnu_decl) == TYPE_DECL
&& TYPE_IS_DUMMY_P (TREE_TYPE (gnu_decl))
&& Ekind (gnat_entity) == E_Record_Subtype
&& No (Freeze_Node (gnat_entity))
&& Present (Cloned_Subtype (gnat_entity))
&& (present_gnu_tree (Cloned_Subtype (gnat_entity))
|| No (Freeze_Node (Cloned_Subtype (gnat_entity)))))
{
gnu_decl
= gnat_to_gnu_entity (Cloned_Subtype (gnat_entity), NULL_TREE,
false);
save_gnu_tree (gnat_entity, NULL_TREE, false); save_gnu_tree (gnat_entity, NULL_TREE, false);
save_gnu_tree (gnat_entity, gnu_decl, false); save_gnu_tree (gnat_entity, gnu_decl, false);
} }
...@@ -3338,14 +3356,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) ...@@ -3338,14 +3356,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
case E_Record_Subtype: case E_Record_Subtype:
/* If Cloned_Subtype is Present it means this record subtype has /* If Cloned_Subtype is Present it means this record subtype has
identical layout to that type or subtype and we should use identical layout to that type or subtype and we should use
that GCC type for this one. The front end guarantees that that GCC type for this one. The front-end guarantees that
the component list is shared. */ the component list is shared. */
if (Present (Cloned_Subtype (gnat_entity))) if (Present (Cloned_Subtype (gnat_entity)))
{ {
gnu_decl = gnat_to_gnu_entity (Cloned_Subtype (gnat_entity), gnu_decl = gnat_to_gnu_entity (Cloned_Subtype (gnat_entity),
NULL_TREE, false); NULL_TREE, false);
gnat_annotate_type = Cloned_Subtype (gnat_entity); gnat_annotate_type = Cloned_Subtype (gnat_entity);
saved = true; maybe_present = true;
break; break;
} }
...@@ -3758,8 +3776,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) ...@@ -3758,8 +3776,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
case E_Access_Subtype: case E_Access_Subtype:
/* We treat this as identical to its base type; any constraint is /* We treat this as identical to its base type; any constraint is
meaningful only to the front-end. */ meaningful only to the front-end. */
gnu_decl = gnat_to_gnu_entity (Etype (gnat_entity), NULL_TREE, false); gnu_decl = gnat_to_gnu_entity (gnat_equiv_type, NULL_TREE, false);
saved = true; maybe_present = true;
/* The designated subtype must be elaborated as well, if it does /* The designated subtype must be elaborated as well, if it does
not have its own freeze node. But designated subtypes created not have its own freeze node. But designated subtypes created
...@@ -4983,6 +5001,10 @@ Gigi_Equivalent_Type (Entity_Id gnat_entity) ...@@ -4983,6 +5001,10 @@ Gigi_Equivalent_Type (Entity_Id gnat_entity)
gnat_equiv = Equivalent_Type (gnat_entity); gnat_equiv = Equivalent_Type (gnat_entity);
break; break;
case E_Access_Subtype:
gnat_equiv = Etype (gnat_entity);
break;
case E_Class_Wide_Type: case E_Class_Wide_Type:
gnat_equiv = Root_Type (gnat_entity); gnat_equiv = Root_Type (gnat_entity);
break; break;
......
2019-06-29 Eric Botcazou <ebotcazou@adacore.com> 2019-06-29 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/specs/array5.ads: New test.
* gnat.dg/specs/array5_pkg1.ads: New helper.
* gnat.dg/specs/array5_pkg2.ads: Likewise.
* gnat.dg/specs/array5_pkg2-g.ads: Likewise.
2019-06-29 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/specs/unchecked_convert1.ads: New test. * gnat.dg/specs/unchecked_convert1.ads: New test.
* gnat.dg/specs/unchecked_convert2.ads: Likewise. * gnat.dg/specs/unchecked_convert2.ads: Likewise.
......
-- { dg-do compile }
with Array5_Pkg1; use Array5_Pkg1;
package Array5 is
C : constant Integer := Arr'Last;
end Array5;
with Array5_Pkg2; use Array5_Pkg2;
with Array5_Pkg2.G;
package Array5_Pkg1 is
type Derived is new Root with record
N : Integer;
end record;
package My_G is new Array5_Pkg2.G (Derived);
type Arr is array (1 .. My_G.Data.N) of Integer;
end Array5_Pkg1;
with System.Address_To_Access_Conversions;
generic
type T is new Root with private;
package Array5_Pkg2.G is
package Ptr is new System.Address_To_Access_Conversions (T);
Data : Ptr.Object_Pointer;
end Array5_Pkg2.G;
package Array5_Pkg2 is
type Root is tagged null record;
end Array5_Pkg2;
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