This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[Ada] Fix ICE on type derived from private discriminated type


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

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

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]