[Ada] Fix segfault on dynamic array bound

Message ID 1984918.kgKzcucoef@polaris
State New
Headers show
Series
  • [Ada] Fix segfault on dynamic array bound
Related show

Commit Message

Eric Botcazou June 29, 2019, 9:08 a.m.
This is a regression present on mainline, 9 and 8 branches: the compiler 
segfaults when trying to elaborate the upper bound of an array whose value is 
obtained through the deference of an access object present in an instance.

Tested on x86-64/Linux, applied on mainline, 9 and 8 branches.


2019-06-29  Eric Botcazou  <ebotcazou@adacore.com>

	* gcc-interface/decl.c (gnat_to_gnu_entity): Beep up comment on SAVED,
	and tweak comment on the assertion about the scopes of Itypes.  Do not
	skip the regular processing for Itypes that are E_Record_Subtype with
	a Cloned_Subtype.  Get the Cloned_Subtype for every E_Record_Subtype
	if the type is dummy and hasn't got its own freeze node.
	<E_Record_Subtype>: Save again the DECL of the Cloned_Subtype, if any.
	<E_Access_Subtype>: Save again the DECL of the equivalent type.
	(Gigi_Equivalent_Type) <E_Access_Subtype>: New case.


2019-06-29  Eric Botcazou  <ebotcazou@adacore.com>

	* gnat.dg/specs/array5.ads: New test.
	* gnat.dg/specs/array5_pkg1.ads: New helper.
	* gnat.dg/specs/array5_pkg2.ads: Likewise.
	* gnat.dg/specs/array5_pkg2-g.ads: Likewise.

-- 
Eric Botcazou

Patch

Index: gcc-interface/decl.c
===================================================================
--- gcc-interface/decl.c	(revision 272820)
+++ gcc-interface/decl.c	(working copy)
@@ -308,7 +308,10 @@  gnat_to_gnu_entity (Entity_Id gnat_entit
   tree gnu_size = NULL_TREE;
   /* Contains the GCC name to be used for the GCC node.  */
   tree gnu_entity_name;
-  /* True if we have already saved gnu_decl as a GNAT association.  */
+  /* True if we have already saved gnu_decl as a GNAT association.  This can
+     also be used to purposely avoid making such an association but this use
+     case ought not to be applied to types because it can break the deferral
+     mechanism implemented for access types.  */
   bool saved = false;
   /* True if we incremented defer_incomplete_level.  */
   bool this_deferred = false;
@@ -325,14 +328,11 @@  gnat_to_gnu_entity (Entity_Id gnat_entit
 
   /* Since a use of an Itype is a definition, process it as such if it is in
      the main unit, except for E_Access_Subtype because it's actually a use
-     of its base type, and for E_Record_Subtype with cloned subtype because
-     it's actually a use of the cloned subtype, see below.  */
+     of its base type, see below.  */
   if (!definition
       && is_type
       && Is_Itype (gnat_entity)
-      && !(kind == E_Access_Subtype
-	   || (kind == E_Record_Subtype
-	       && Present (Cloned_Subtype (gnat_entity))))
+      && Ekind (gnat_entity) != E_Access_Subtype
       && !present_gnu_tree (gnat_entity)
       && In_Extended_Main_Code_Unit (gnat_entity))
     {
@@ -375,7 +375,7 @@  gnat_to_gnu_entity (Entity_Id gnat_entit
 	}
 
       /* This abort means the Itype has an incorrect scope, i.e. that its
-	 scope does not correspond to the subprogram it is declared in.  */
+	 scope does not correspond to the subprogram it is first used in.  */
       gcc_unreachable ();
     }
 
@@ -384,7 +384,9 @@  gnat_to_gnu_entity (Entity_Id gnat_entit
      In that case, we will abort below when we try to save a new GCC tree
      for this object.  We also need to handle the case of getting a dummy
      type when a Full_View exists but be careful so as not to trigger its
-     premature elaboration.  */
+     premature elaboration.  Likewise for a cloned subtype without its own
+     freeze node, which typically happens when a generic gets instantiated
+     on an incomplete or private type.  */
   if ((!definition || (is_type && imported_p))
       && present_gnu_tree (gnat_entity))
     {
@@ -398,7 +400,23 @@  gnat_to_gnu_entity (Entity_Id gnat_entit
 	      || No (Freeze_Node (Full_View (gnat_entity)))))
 	{
 	  gnu_decl
-	    = gnat_to_gnu_entity (Full_View (gnat_entity), NULL_TREE, false);
+	    = gnat_to_gnu_entity (Full_View (gnat_entity), NULL_TREE,
+				  false);
+	  save_gnu_tree (gnat_entity, NULL_TREE, false);
+	  save_gnu_tree (gnat_entity, gnu_decl, false);
+	}
+
+      if (TREE_CODE (gnu_decl) == TYPE_DECL
+	  && TYPE_IS_DUMMY_P (TREE_TYPE (gnu_decl))
+	  && Ekind (gnat_entity) == E_Record_Subtype
+	  && No (Freeze_Node (gnat_entity))
+	  && Present (Cloned_Subtype (gnat_entity))
+	  && (present_gnu_tree (Cloned_Subtype (gnat_entity))
+	      || No (Freeze_Node (Cloned_Subtype (gnat_entity)))))
+	{
+	  gnu_decl
+	    = gnat_to_gnu_entity (Cloned_Subtype (gnat_entity), NULL_TREE,
+				  false);
 	  save_gnu_tree (gnat_entity, NULL_TREE, false);
 	  save_gnu_tree (gnat_entity, gnu_decl, false);
 	}
@@ -3338,14 +3356,14 @@  gnat_to_gnu_entity (Entity_Id gnat_entit
     case E_Record_Subtype:
       /* If Cloned_Subtype is Present it means this record subtype has
 	 identical layout to that type or subtype and we should use
-	 that GCC type for this one.  The front end guarantees that
+	 that GCC type for this one.  The front-end guarantees that
 	 the component list is shared.  */
       if (Present (Cloned_Subtype (gnat_entity)))
 	{
 	  gnu_decl = gnat_to_gnu_entity (Cloned_Subtype (gnat_entity),
 					 NULL_TREE, false);
 	  gnat_annotate_type = Cloned_Subtype (gnat_entity);
-	  saved = true;
+	  maybe_present = true;
 	  break;
 	}
 
@@ -3758,8 +3776,8 @@  gnat_to_gnu_entity (Entity_Id gnat_entit
     case E_Access_Subtype:
       /* We treat this as identical to its base type; any constraint is
 	 meaningful only to the front-end.  */
-      gnu_decl = gnat_to_gnu_entity (Etype (gnat_entity), NULL_TREE, false);
-      saved = true;
+      gnu_decl = gnat_to_gnu_entity (gnat_equiv_type, NULL_TREE, false);
+      maybe_present = true;
 
       /* The designated subtype must be elaborated as well, if it does
 	 not have its own freeze node.  But designated subtypes created
@@ -4983,6 +5001,10 @@  Gigi_Equivalent_Type (Entity_Id gnat_ent
 	gnat_equiv = Equivalent_Type (gnat_entity);
       break;
 
+    case E_Access_Subtype:
+      gnat_equiv = Etype (gnat_entity);
+      break;
+
     case E_Class_Wide_Type:
       gnat_equiv = Root_Type (gnat_entity);
       break;