Re: [Ada PATCH] don't modify record fields in update_pointer_to

[Eric Botcazou <ebotcazou at adacore dot com>]

> What do you think?  At least it's clean on ACATS.

And clean everywhere.  Attached is the patch I propose to apply.  OK with you?

2007-06-10  Duncan Sands  <baldrick@free.fr>

	* decl.c (gnat_to_gnu_entity): Use pointers to dummy nodes, rather than
	to void, for the fields when making a new fat pointer type.
	(gnat_substitute_in_type): Now substitute_in_type.
	* gigi.h (gnat_substitute_in_type): Likewise.
	* trans.c (gnat_gimplify_expr): Remove COMPONENT_REF kludge.
	* utils.c (update_pointer_to): Update fat pointers by updating the dummy
	node pointers used for the fields.

Btw, can you confirm again that you have a copyright assignment on file?

-- 
Eric Botcazou

Index: decl.c
===================================================================
--- decl.c	(revision 125589)
+++ decl.c	(working copy)
@@ -3041,13 +3041,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
 	     && ! Is_Constrained (gnat_desig_rep));
 
 	/* If we are pointing to an incomplete type whose completion is an
-	   unconstrained array, make a fat pointer type instead of a pointer
-	   to VOID.  The two types in our fields will be pointers to VOID and
-	   will be replaced in update_pointer_to.  Similarly, if the type
-	   itself is a dummy type or an unconstrained array.  Also make
-	   a dummy TYPE_OBJECT_RECORD_TYPE in case we have any thin
-	   pointers to it.  */
-
+	   unconstrained array, make a fat pointer type.  The two types in our
+	   fields will be pointers to dummy nodes and will be replaced in
+	   update_pointer_to.  Similarly, if the type itself is a dummy type or
+	   an unconstrained array.  Also make a dummy TYPE_OBJECT_RECORD_TYPE
+	   in case we have any thin pointers to it.  */
 	if (is_unconstrained_array
 	    && (Present (gnat_desig_full)
 		|| (present_gnu_tree (gnat_desig_equiv)
@@ -3075,6 +3073,21 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
 	    gnu_type = TYPE_POINTER_TO (gnu_old);
 	    if (!gnu_type)
 	      {
+		tree gnu_template_type = make_node (ENUMERAL_TYPE);
+		tree gnu_ptr_template = build_pointer_type (gnu_template_type);
+		tree gnu_array_type = make_node (ENUMERAL_TYPE);
+		tree gnu_ptr_array = build_pointer_type (gnu_array_type);
+
+		TYPE_NAME (gnu_template_type)
+		  = concat_id_with_name (get_entity_name (gnat_desig_equiv),
+					 "XUB");
+		TYPE_DUMMY_P (gnu_template_type) = 1;
+
+		TYPE_NAME (gnu_array_type)
+		  = concat_id_with_name (get_entity_name (gnat_desig_equiv),
+					 "XUA");
+		TYPE_DUMMY_P (gnu_array_type) = 1;
+
 		gnu_type = make_node (RECORD_TYPE);
 		SET_TYPE_UNCONSTRAINED_ARRAY (gnu_type, gnu_old);
 		TYPE_POINTER_TO (gnu_old) = gnu_type;
@@ -3084,10 +3097,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
 		  = chainon (chainon (NULL_TREE,
 				      create_field_decl
 				      (get_identifier ("P_ARRAY"),
-				       ptr_void_type_node, gnu_type,
-				       0, 0, 0, 0)),
+				       gnu_ptr_array,
+				       gnu_type, 0, 0, 0, 0)),
 			     create_field_decl (get_identifier ("P_BOUNDS"),
-						ptr_void_type_node,
+						gnu_ptr_template,
 						gnu_type, 0, 0, 0, 0));
 
 		/* Make sure we can place this into a register.  */
@@ -6846,14 +6859,13 @@ compatible_signatures_p (tree ftype1, tr
   return 1;
 }
 
-/* Given a type T, a FIELD_DECL F, and a replacement value R, return a new type
-   with all size expressions that contain F updated by replacing F with R.
-   This is identical to GCC's substitute_in_type except that it knows about
-   TYPE_INDEX_TYPE.  If F is NULL_TREE, always make a new RECORD_TYPE, even if
+/* Given a type T, a FIELD_DECL F, and a replacement value R, return a new
+   type with all size expressions that contain F updated by replacing F
+   with R.  If F is NULL_TREE, always make a new RECORD_TYPE, even if
    nothing has changed.  */
 
 tree
-gnat_substitute_in_type (tree t, tree f, tree r)
+substitute_in_type (tree t, tree f, tree r)
 {
   tree new = t;
   tree tem;
@@ -6875,7 +6887,7 @@ gnat_substitute_in_type (tree t, tree f,
 	  new = build_range_type (TREE_TYPE (t), low, high);
 	  if (TYPE_INDEX_TYPE (t))
 	    SET_TYPE_INDEX_TYPE
-	      (new, gnat_substitute_in_type (TYPE_INDEX_TYPE (t), f, r));
+	      (new, substitute_in_type (TYPE_INDEX_TYPE (t), f, r));
 	  return new;
 	}
 
@@ -6902,7 +6914,7 @@ gnat_substitute_in_type (tree t, tree f,
       return t;
 
     case COMPLEX_TYPE:
-      tem = gnat_substitute_in_type (TREE_TYPE (t), f, r);
+      tem = substitute_in_type (TREE_TYPE (t), f, r);
       if (tem == TREE_TYPE (t))
 	return t;
 
@@ -6917,8 +6929,8 @@ gnat_substitute_in_type (tree t, tree f,
 
     case ARRAY_TYPE:
       {
-	tree component = gnat_substitute_in_type (TREE_TYPE (t), f, r);
-	tree domain = gnat_substitute_in_type (TYPE_DOMAIN (t), f, r);
+	tree component = substitute_in_type (TREE_TYPE (t), f, r);
+	tree domain = substitute_in_type (TYPE_DOMAIN (t), f, r);
 
 	if (component == TREE_TYPE (t) && domain == TYPE_DOMAIN (t))
 	  return t;
@@ -6968,7 +6980,7 @@ gnat_substitute_in_type (tree t, tree f,
 	    tree new_field = copy_node (field);
 
 	    TREE_TYPE (new_field)
-	      = gnat_substitute_in_type (TREE_TYPE (new_field), f, r);
+	      = substitute_in_type (TREE_TYPE (new_field), f, r);
 
 	    if (DECL_HAS_REP_P (field) && !DECL_INTERNAL_P (field))
 	      field_has_rep = true;
Index: gigi.h
===================================================================
--- gigi.h	(revision 125589)
+++ gigi.h	(working copy)
@@ -160,11 +160,11 @@ extern tree maybe_pad_type (tree type, t
    the value passed against the list of choices.  */
 extern tree choices_to_gnu (tree operand, Node_Id choices);
 
-/* Given a type T, a FIELD_DECL F, and a replacement value R,
-   return a new type with all size expressions that contain F
-   updated by replacing F with R.  This is identical to GCC's
-   substitute_in_type except that it knows about TYPE_INDEX_TYPE.  */
-extern tree gnat_substitute_in_type (tree t, tree f, tree r);
+/* Given a type T, a FIELD_DECL F, and a replacement value R, return a new
+   type with all size expressions that contain F updated by replacing F
+   with R.  If F is NULL_TREE, always make a new RECORD_TYPE, even if
+   nothing has changed.  */
+extern tree substitute_in_type (tree t, tree f, tree r);
 
 /* Return the "RM size" of GNU_TYPE.  This is the actual number of bits
    needed to represent the object.  */
Index: trans.c
===================================================================
--- trans.c	(revision 125589)
+++ trans.c	(working copy)
@@ -5201,19 +5201,6 @@ gnat_gimplify_expr (tree *expr_p, tree *
 	  return GS_ALL_DONE;
 	}
 
-      return GS_UNHANDLED;
-
-    case COMPONENT_REF:
-      /* We have a kludge here.  If the FIELD_DECL is from a fat pointer and is
-	 from an early dummy type, replace it with the proper FIELD_DECL.  */
-      if (TYPE_FAT_POINTER_P (TREE_TYPE (TREE_OPERAND (*expr_p, 0)))
-	  && DECL_ORIGINAL_FIELD (TREE_OPERAND (*expr_p, 1)))
-	{
-	  TREE_OPERAND (*expr_p, 1)
-	    = DECL_ORIGINAL_FIELD (TREE_OPERAND (*expr_p, 1));
-	  return GS_OK;
-	}
-
       /* ... fall through ... */
 
     default:
Index: utils.c
===================================================================
--- utils.c	(revision 125589)
+++ utils.c	(working copy)
@@ -3160,75 +3160,64 @@ update_pointer_to (tree old_type, tree n
     }
 
   /* Now deal with the unconstrained array case. In this case the "pointer"
-     is actually a RECORD_TYPE where the types of both fields are
-     pointers to void.  In that case, copy the field list from the
-     old type to the new one and update the fields' context. */
+     is actually a RECORD_TYPE where both fields are pointers to dummy nodes.
+     Turn them into pointers to the correct types using update_pointer_to.  */
   else if (TREE_CODE (ptr) != RECORD_TYPE || !TYPE_IS_FAT_POINTER_P (ptr))
     gcc_unreachable ();
 
   else
     {
       tree new_obj_rec = TYPE_OBJECT_RECORD_TYPE (new_type);
-      tree fields = TYPE_FIELDS (TYPE_POINTER_TO (new_type));
-      tree new_fields, ptr_temp_type, new_ref, bounds, var;
-
-      /* Replace contents of old pointer with those of new pointer.  */
-      new_fields = copy_node (fields);
-      TREE_CHAIN (new_fields) = copy_node (TREE_CHAIN (fields));
-
-      SET_DECL_ORIGINAL_FIELD (TYPE_FIELDS (ptr), new_fields);
-      SET_DECL_ORIGINAL_FIELD (TREE_CHAIN (TYPE_FIELDS (ptr)),
-			       TREE_CHAIN (new_fields));
-
-      TYPE_FIELDS (ptr) = new_fields;
-      DECL_CONTEXT (new_fields) = ptr;
-      DECL_CONTEXT (TREE_CHAIN (new_fields)) = ptr;
-
-      /* Rework the PLACEHOLDER_EXPR inside the reference to the template
-	 bounds and update the pointers to them.
-
-	 ??? This is now the only use of gnat_substitute_in_type, which
-	 is now a very "heavy" routine to do this, so it should be replaced
-	 at some point.  */
-      bounds = TREE_TYPE (TREE_TYPE (new_fields));
-      ptr_temp_type = TREE_TYPE (TREE_CHAIN (new_fields));
-      new_ref = build3 (COMPONENT_REF, ptr_temp_type,
+      tree array_field = TYPE_FIELDS (ptr);
+      tree bounds_field = TREE_CHAIN (TYPE_FIELDS (ptr));
+      tree new_ptr = TYPE_POINTER_TO (new_type);
+      tree new_ref;
+      tree var;
+
+      /* Make pointers to the dummy template point to the real template.  */
+      update_pointer_to
+	(TREE_TYPE (TREE_TYPE (bounds_field)),
+	 TREE_TYPE (TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (new_ptr)))));
+
+      /* The references to the template bounds present in the array type
+	 are made through a PLACEHOLDER_EXPR of type new_ptr.  Since we
+	 are updating ptr to make it a full replacement for new_ptr as
+	 pointer to new_type, we must rework the PLACEHOLDER_EXPR so as
+	 to make it of type ptr.  */
+      new_ref = build3 (COMPONENT_REF, TREE_TYPE (bounds_field),
 			build0 (PLACEHOLDER_EXPR, ptr),
-			TREE_CHAIN (new_fields), NULL_TREE);
-      update_pointer_to (bounds,
-			 gnat_substitute_in_type (bounds,
-						  TREE_CHAIN (fields),
-						  new_ref));
+			bounds_field, NULL_TREE);
 
-      for (var = TYPE_MAIN_VARIANT (ptr); var; var = TYPE_NEXT_VARIANT (var))
-	{
-	  SET_TYPE_UNCONSTRAINED_ARRAY (var, new_type);
+      /* Create the new array for the new PLACEHOLDER_EXPR and make
+	 pointers to the dummy array point to it.
 
-	  /* This may seem a bit gross, in particular wrt DECL_CONTEXT, but
-	     actually is in keeping with what build_qualified_type does.  */
-	  TYPE_FIELDS (var) = new_fields;
-	}
+	 ??? This is now the only use of substitute_in_type,
+	 which is a very "heavy" routine to do this, so it
+	 should be replaced at some point.  */
+      update_pointer_to
+	(TREE_TYPE (TREE_TYPE (array_field)),
+	 substitute_in_type (TREE_TYPE (TREE_TYPE (TYPE_FIELDS (new_ptr))),
+			     TREE_CHAIN (TYPE_FIELDS (new_ptr)), new_ref));
 
+      /* Make ptr the pointer to new_type.  */
       TYPE_POINTER_TO (new_type) = TYPE_REFERENCE_TO (new_type)
 	= TREE_TYPE (new_type) = ptr;
 
+      for (var = TYPE_MAIN_VARIANT (ptr); var; var = TYPE_NEXT_VARIANT (var))
+	SET_TYPE_UNCONSTRAINED_ARRAY (var, new_type);
+
       /* Now handle updating the allocation record, what the thin pointer
 	 points to.  Update all pointers from the old record into the new
-	 one, update the types of the fields, and recompute the size.  */
-
+	 one, update the type of the array field, and recompute the size.  */
       update_pointer_to (TYPE_OBJECT_RECORD_TYPE (old_type), new_obj_rec);
 
-      TREE_TYPE (TYPE_FIELDS (new_obj_rec))
-	= TREE_TYPE (TREE_TYPE (TREE_CHAIN (new_fields)));
-
       TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (new_obj_rec)))
-	= TREE_TYPE (TREE_TYPE (new_fields));
+	= TREE_TYPE (TREE_TYPE (array_field));
 
       /* The size recomputation needs to account for alignment constraints, so
 	 we let layout_type work it out.  This will reset the field offsets to
 	 what they would be in a regular record, so we shift them back to what
 	 we want them to be for a thin pointer designated type afterwards.  */
-
       DECL_SIZE (TYPE_FIELDS (new_obj_rec)) = 0;
       DECL_SIZE (TREE_CHAIN (TYPE_FIELDS (new_obj_rec))) = 0;
       TYPE_SIZE (new_obj_rec) = 0;