decl.c (gnat_to_gnu_entity): For a derived untagged type that renames discriminants...

	* 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.

From-SVN: r217153

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 7e8e9a1..72c0313 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,12 @@
 2014-11-05  Eric Botcazou  <ebotcazou@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  <ebotcazou@adacore.com>
+
        * 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 05be419..2ed68d4 100644 (file)
--- 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 d227828..913b5c7 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,10 @@
 2014-11-05  Eric Botcazou  <ebotcazou@adacore.com>
 
+       * gnat.dg/specs/private2.ads: New test.
+       * gnat.dg/specs/private2_pkg.ads: New helper.
+
+2014-11-05  Eric Botcazou  <ebotcazou@adacore.com>
+
        * 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 (file)
index 0000000..d6fff38
--- /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 (file)
index 0000000..468d239
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/specs/private2_pkg.ads
@@ -0,0 +1,11 @@
+package Private2_Pkg is\r
+\r
+   type Rec2 (D : Natural) is private;\r
+\r
+private\r
+\r
+   type Rec1 (D : Natural) is null record;\r
+\r
+   type Rec2 (D : Natural) is new Rec1 (D);\r
+\r
+end Private2_Pkg;\r