This is a regression present on mainline, 9 and 8 branches: the compiler
segfaults when trying to elaborate the upper bound of an array whose value is
obtained through the deference of an access object present in an instance.
Tested on x86-64/Linux, applied on mainline, 9 and 8 branches.
2019-06-29 Eric Botcazou <ebotca...@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 <ebotca...@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.
--
Eric Botcazouwith 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;
with Array5_Pkg1; use Array5_Pkg1;
package Array5 is
C : constant Integer := Arr'Last;
end Array5;
Index: gcc-interface/decl.c
===================================================================
--- gcc-interface/decl.c (revision 272820)
+++ gcc-interface/decl.c (working copy)
@@ -308,7 +308,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
tree gnu_size = NULL_TREE;
/* Contains the GCC name to be used for the GCC node. */
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;
/* True if we incremented defer_incomplete_level. */
bool this_deferred = false;
@@ -325,14 +328,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
/* 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
- of its base type, and for E_Record_Subtype with cloned subtype because
- it's actually a use of the cloned subtype, see below. */
+ of its base type, see below. */
if (!definition
&& is_type
&& Is_Itype (gnat_entity)
- && !(kind == E_Access_Subtype
- || (kind == E_Record_Subtype
- && Present (Cloned_Subtype (gnat_entity))))
+ && Ekind (gnat_entity) != E_Access_Subtype
&& !present_gnu_tree (gnat_entity)
&& In_Extended_Main_Code_Unit (gnat_entity))
{
@@ -375,7 +375,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
}
/* 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 ();
}
@@ -384,7 +384,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
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
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))
&& present_gnu_tree (gnat_entity))
{
@@ -398,7 +400,23 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
|| No (Freeze_Node (Full_View (gnat_entity)))))
{
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, gnu_decl, false);
}
@@ -3338,14 +3356,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
case E_Record_Subtype:
/* If Cloned_Subtype is Present it means this record subtype has
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. */
if (Present (Cloned_Subtype (gnat_entity)))
{
gnu_decl = gnat_to_gnu_entity (Cloned_Subtype (gnat_entity),
NULL_TREE, false);
gnat_annotate_type = Cloned_Subtype (gnat_entity);
- saved = true;
+ maybe_present = true;
break;
}
@@ -3758,8 +3776,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
case E_Access_Subtype:
/* We treat this as identical to its base type; any constraint is
meaningful only to the front-end. */
- gnu_decl = gnat_to_gnu_entity (Etype (gnat_entity), NULL_TREE, false);
- saved = true;
+ gnu_decl = gnat_to_gnu_entity (gnat_equiv_type, NULL_TREE, false);
+ maybe_present = true;
/* The designated subtype must be elaborated as well, if it does
not have its own freeze node. But designated subtypes created
@@ -4983,6 +5001,10 @@ Gigi_Equivalent_Type (Entity_Id gnat_ent
gnat_equiv = Equivalent_Type (gnat_entity);
break;
+ case E_Access_Subtype:
+ gnat_equiv = Etype (gnat_entity);
+ break;
+
case E_Class_Wide_Type:
gnat_equiv = Root_Type (gnat_entity);
break;
