The compiler aborts on a record type derived from a private discriminated
record type without discriminant contraints, if the private discriminated
record type is itself derived from another discriminated record type.
Tested on x86_64-suse-linux, applied on the mainline.
2014-11-05 Eric Botcazou <ebotca...@adacore.com>
* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Record_Type>: For a
derived untagged type that renames discriminants, be prepared for
a type derived from a private discriminated type when changing the
type of the stored discriminants.
2014-11-05 Eric Botcazou <ebotca...@adacore.com>
* gnat.dg/specs/private2.ads: New test.
* gnat.dg/specs/private2_pkg.ads: New helper.
--
Eric Botcazou
Index: gcc-interface/decl.c
===================================================================
--- gcc-interface/decl.c (revision 217119)
+++ gcc-interface/decl.c (working copy)
@@ -3056,7 +3056,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
gnat_field = Next_Stored_Discriminant (gnat_field))
if (Present (Corresponding_Discriminant (gnat_field)))
{
- Entity_Id field = Empty;
+ Entity_Id field;
for (field = First_Stored_Discriminant (gnat_parent);
Present (field);
field = Next_Stored_Discriminant (field))
@@ -3138,8 +3138,30 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
&& Ekind (Entity (Node (gnat_constr))) == E_Discriminant)
{
Entity_Id gnat_discr = Entity (Node (gnat_constr));
- tree gnu_discr_type = gnat_to_gnu_type (Etype (gnat_discr));
- tree gnu_ref
+ tree gnu_discr_type, gnu_ref;
+
+ /* If the scope of the discriminant is not the record type,
+ this means that we're processing the implicit full view
+ of a type derived from a private discriminated type: in
+ this case, the Stored_Constraint list is simply copied
+ from the partial view, see Build_Derived_Private_Type.
+ So we need to retrieve the corresponding discriminant
+ of the implicit full view, otherwise we will abort. */
+ if (Scope (gnat_discr) != gnat_entity)
+ {
+ Entity_Id field;
+ for (field = First_Entity (gnat_entity);
+ Present (field);
+ field = Next_Entity (field))
+ if (Ekind (field) == E_Discriminant
+ && same_discriminant_p (gnat_discr, field))
+ break;
+ gcc_assert (Present (field));
+ gnat_discr = field;
+ }
+
+ gnu_discr_type = gnat_to_gnu_type (Etype (gnat_discr));
+ gnu_ref
= gnat_to_gnu_entity (Original_Record_Component (gnat_discr),
NULL_TREE, 0);
-- { dg-do compile }
with Private2_Pkg; use Private2_Pkg;
package Private2 is
type R is new Rec2;
end Private2;
package Private2_Pkg is
type Rec2 (D : Natural) is private;
private
type Rec1 (D : Natural) is null record;
type Rec2 (D : Natural) is new Rec1 (D);
end Private2_Pkg;