From e028b0bbca86c369c145a410cf06a65d729c91d6 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Wed, 5 Nov 2014 19:03:26 +0000 Subject: [PATCH] decl.c (gnat_to_gnu_entity): For a derived untagged type that renames discriminants... * gcc-interface/decl.c (gnat_to_gnu_entity) : 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. From-SVN: r217153 --- gcc/ada/ChangeLog | 7 +++++ gcc/ada/gcc-interface/decl.c | 28 +++++++++++++++++--- gcc/testsuite/ChangeLog | 5 ++++ gcc/testsuite/gnat.dg/specs/private2.ads | 9 +++++++ gcc/testsuite/gnat.dg/specs/private2_pkg.ads | 11 ++++++++ 5 files changed, 57 insertions(+), 3 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/specs/private2.ads create mode 100644 gcc/testsuite/gnat.dg/specs/private2_pkg.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 7e8e9a127bf..72c0313afd3 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2014-11-05 Eric Botcazou + + * gcc-interface/decl.c (gnat_to_gnu_entity) : 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 * gcc-interface/trans.c (Handled_Sequence_Of_Statements_to_gnu): Set diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 05be419ce94..2ed68d49578 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -3056,7 +3056,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) 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_entity, tree gnu_expr, int definition) && 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); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index d227828c321..913b5c72766 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2014-11-05 Eric Botcazou + + * gnat.dg/specs/private2.ads: New test. + * gnat.dg/specs/private2_pkg.ads: New helper. + 2014-11-05 Eric Botcazou * gnat.dg/inline1.adb: New test. diff --git a/gcc/testsuite/gnat.dg/specs/private2.ads b/gcc/testsuite/gnat.dg/specs/private2.ads new file mode 100644 index 00000000000..d6fff3856ab --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/private2.ads @@ -0,0 +1,9 @@ +-- { dg-do compile } + +with Private2_Pkg; use Private2_Pkg; + +package Private2 is + + type R is new Rec2; + +end Private2; diff --git a/gcc/testsuite/gnat.dg/specs/private2_pkg.ads b/gcc/testsuite/gnat.dg/specs/private2_pkg.ads new file mode 100644 index 00000000000..468d239e53b --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/private2_pkg.ads @@ -0,0 +1,11 @@ +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; -- 2.30.2