From 35f63fec1fec65171e934e1d0a1e0ab3031824b0 Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Wed, 5 Nov 2014 19:03:26 +0000 Subject: [PATCH] * 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@217153 138bc75d-0d04-0410-961f-82ee72b054a4 --- 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,5 +1,12 @@ 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 the SLOC of the node on the call to set_jmpbuf_address_soft emitted on block entry with SJLJ. 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,5 +1,10 @@ 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. * gnat.dg/inline1_pkg.ad[sb]: New helper. * gnat.dg/inline2.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.11.4.GIT