Patchwork [Ada] Fix unexpected allocation change with size clause

login
register
mail settings
Submitter Eric Botcazou
Date June 11, 2012, 9:09 a.m.
Message ID <201206111109.11531.ebotcazou@adacore.com>
Download mbox | patch
Permalink /patch/164103/
State New
Headers show

Comments

Eric Botcazou - June 11, 2012, 9:09 a.m.
The attached packages declare two big objects of the same size, but for the 
first package the object is allocated statically whereas, for the second one, 
the object is allocated dynamically because of the size clause.

The discrepancy stems from a bit vs byte confusion in a specific place in gigi.

Tested on i586-suse-linux, applied on the mainline.


2012-06-11  Eric Botcazou  <ebotcazou@adacore.com>

	* gcc-interface/decl.c (gnat_to_gnu_entity) <object>: Convert GNU_SIZE
	to units before invoking allocatable_size_p on it.
	Remove orphaned comment.  Do not use ssize_int.
	<E_Record_Subtype>: Traverse list in original order.  Minor tweak.
	(allocatable_size_p): Adjust and simplify.
	(build_subst_list): Use consistent terminology throughout.
	(build_variant_list): Likewise.  Traverse list in original order.
	(create_field_decl_from): Likewise.
	(copy_and_substitute_in_size): Likewise.
	(create_variant_part_from): Add comment about field list order.
	* gcc-interface/utils.c (build_vms_descriptor): Do not use ssize_int.
	* gcc-interface/utils2.c (build_allocator): Likewise.


2012-06-11  Eric Botcazou  <ebotcazou@adacore.com>

	* gnat.dg/specs/array1.ads: New test.
	* gnat.dg/specs/array2.ads: Likewise.
	* gnat.dg/array22.adb: Likewise.

Patch

Index: gcc-interface/utils.c
===================================================================
--- gcc-interface/utils.c	(revision 188379)
+++ gcc-interface/utils.c	(working copy)
@@ -3601,7 +3601,7 @@  build_vms_descriptor (tree type, Mechani
 			     record_type, size_int (klass), field_list);
   field_list
     = make_descriptor_field ("MBMO", gnat_type_for_size (32, 1),
-			     record_type, ssize_int (-1), field_list);
+			     record_type, size_int (-1), field_list);
   field_list
     = make_descriptor_field ("LENGTH", gnat_type_for_size (64, 1),
 			     record_type,
Index: gcc-interface/decl.c
===================================================================
--- gcc-interface/decl.c	(revision 188379)
+++ gcc-interface/decl.c	(working copy)
@@ -1283,10 +1283,14 @@  gnat_to_gnu_entity (Entity_Id gnat_entit
 				 global_bindings_p ()
 				 || !definition
 				 || static_p)
-	    || (gnu_size && !allocatable_size_p (gnu_size,
-						 global_bindings_p ()
-						 || !definition
-						 || static_p)))
+	    || (gnu_size
+		&& !allocatable_size_p (convert (sizetype,
+						 size_binop
+						 (CEIL_DIV_EXPR, gnu_size,
+						  bitsize_unit_node)),
+					global_bindings_p ()
+					|| !definition
+					|| static_p)))
 	  {
 	    gnu_type = build_reference_type (gnu_type);
 	    gnu_size = NULL_TREE;
@@ -2204,8 +2208,6 @@  gnat_to_gnu_entity (Entity_Id gnat_entit
 			    debug_info_p);
 	TYPE_READONLY (gnu_template_type) = 1;
 
-	/* Now build the array type.  */
-
 	/* If Component_Size is not already specified, annotate it with the
 	   size of the component.  */
 	if (Unknown_Component_Size (gnat_entity))
@@ -2810,12 +2812,14 @@  gnat_to_gnu_entity (Entity_Id gnat_entit
 	tree gnu_lower_bound
 	  = convert (gnu_string_index_type,
 		     gnat_to_gnu (String_Literal_Low_Bound (gnat_entity)));
-	int length = UI_To_Int (String_Literal_Length (gnat_entity));
-	tree gnu_length = ssize_int (length - 1);
+	tree gnu_length
+	  = UI_To_gnu (String_Literal_Length (gnat_entity),
+		       gnu_string_index_type);
 	tree gnu_upper_bound
 	  = build_binary_op (PLUS_EXPR, gnu_string_index_type,
 			     gnu_lower_bound,
-			     convert (gnu_string_index_type, gnu_length));
+			     int_const_binop (MINUS_EXPR, gnu_length,
+					      integer_one_node));
 	tree gnu_index_type
 	  = create_index_type (convert (sizetype, gnu_lower_bound),
 			       convert (sizetype, gnu_upper_bound),
@@ -3298,7 +3302,7 @@  gnat_to_gnu_entity (Entity_Id gnat_entit
 	      if (gnu_variant_part)
 		{
 		  variant_desc *v;
-		  unsigned ix;
+		  unsigned int i;
 
 		  gnu_variant_list
 		    = build_variant_list (TREE_TYPE (gnu_variant_part),
@@ -3307,8 +3311,7 @@  gnat_to_gnu_entity (Entity_Id gnat_entit
 		  /* If all the qualifiers are unconditionally true, the
 		     innermost variant is statically selected.  */
 		  selected_variant = true;
-		  FOR_EACH_VEC_ELT_REVERSE (variant_desc, gnu_variant_list,
-					    ix, v)
+		  FOR_EACH_VEC_ELT (variant_desc, gnu_variant_list, i, v)
 		    if (!integer_onep (v->qual))
 		      {
 			selected_variant = false;
@@ -3317,8 +3320,7 @@  gnat_to_gnu_entity (Entity_Id gnat_entit
 
 		  /* Otherwise, create the new variants.  */
 		  if (!selected_variant)
-		    FOR_EACH_VEC_ELT_REVERSE (variant_desc, gnu_variant_list,
-					      ix, v)
+		    FOR_EACH_VEC_ELT (variant_desc, gnu_variant_list, i, v)
 		      {
 			tree old_variant = v->type;
 			tree new_variant = make_node (RECORD_TYPE);
@@ -3420,11 +3422,10 @@  gnat_to_gnu_entity (Entity_Id gnat_entit
 		    else
 		      {
 			variant_desc *v;
-			unsigned ix;
+			unsigned int i;
 
 			t = NULL_TREE;
-			FOR_EACH_VEC_ELT_REVERSE (variant_desc,
-						  gnu_variant_list, ix, v)
+			FOR_EACH_VEC_ELT (variant_desc, gnu_variant_list, i, v)
 			  if (v->type == gnu_context)
 			    {
 			      t = v->type;
@@ -3510,8 +3511,8 @@  gnat_to_gnu_entity (Entity_Id gnat_entit
 
 	      /* Do not emit debug info for the type yet since we're going to
 		 modify it below.  */
-	      gnu_field_list = nreverse (gnu_field_list);
-	      finish_record_type (gnu_type, gnu_field_list, 2, false);
+	      finish_record_type (gnu_type, nreverse (gnu_field_list), 2,
+				  false);
 
 	      /* See the E_Record_Type case for the rationale.  */
 	      if (Is_By_Reference_Type (gnat_entity))
@@ -5933,30 +5934,21 @@  elaborate_entity (Entity_Id gnat_entity)
     }
 }
 
-/* Return true if the size represented by GNU_SIZE can be handled by an
-   allocation.  If STATIC_P is true, consider only what can be done with a
+/* Return true if the size in units represented by GNU_SIZE can be handled by
+   an allocation.  If STATIC_P is true, consider only what can be done with a
    static allocation.  */
 
 static bool
 allocatable_size_p (tree gnu_size, bool static_p)
 {
-  HOST_WIDE_INT our_size;
-
-  /* If this is not a static allocation, the only case we want to forbid
-     is an overflowing size.  That will be converted into a raise a
-     Storage_Error.  */
-  if (!static_p)
-    return !(TREE_CODE (gnu_size) == INTEGER_CST
-	     && TREE_OVERFLOW (gnu_size));
-
-  /* Otherwise, we need to deal with both variable sizes and constant
-     sizes that won't fit in a host int.  We use int instead of HOST_WIDE_INT
-     since assemblers may not like very large sizes.  */
-  if (!host_integerp (gnu_size, 1))
-    return false;
+  /* We can allocate a fixed size if it hasn't overflowed and can be handled
+     (efficiently) on the host.  */
+  if (TREE_CODE (gnu_size) == INTEGER_CST)
+    return !TREE_OVERFLOW (gnu_size) && host_integerp (gnu_size, 1);
 
-  our_size = tree_low_cst (gnu_size, 1);
-  return (int) our_size == our_size;
+  /* We can allocate a variable size if this isn't a static allocation.  */
+  else
+    return !static_p;
 }
 
 /* Prepend to ATTR_LIST an entry for an attribute with provided TYPE,
@@ -7502,16 +7494,16 @@  build_position_list (tree gnu_type, bool
   return gnu_list;
 }
 
-/* Return a VEC describing the substitutions needed to reflect the
+/* Return a list describing the substitutions needed to reflect the
    discriminant substitutions from GNAT_TYPE to GNAT_SUBTYPE.  They can
-   be in any order.  The values in an element of the VEC are in the form
+   be in any order.  The values in an element of the list are in the form
    of operands to SUBSTITUTE_IN_EXPR.  DEFINITION is true if this is for
    a definition of GNAT_SUBTYPE.  */
 
 static VEC(subst_pair,heap) *
 build_subst_list (Entity_Id gnat_subtype, Entity_Id gnat_type, bool definition)
 {
-  VEC(subst_pair,heap) *gnu_vec = NULL;
+  VEC(subst_pair,heap) *gnu_list = NULL;
   Entity_Id gnat_discrim;
   Node_Id gnat_value;
 
@@ -7529,23 +7521,22 @@  build_subst_list (Entity_Id gnat_subtype
 				    (Node (gnat_value), gnat_subtype,
 				     get_entity_name (gnat_discrim),
 				     definition, true, false));
-	subst_pair *s = VEC_safe_push (subst_pair, heap, gnu_vec, NULL);
+	subst_pair *s = VEC_safe_push (subst_pair, heap, gnu_list, NULL);
 	s->discriminant = gnu_field;
 	s->replacement = replacement;
       }
 
-  return gnu_vec;
+  return gnu_list;
 }
 
-/* Scan all fields in QUAL_UNION_TYPE and return a VEC describing the
+/* Scan all fields in QUAL_UNION_TYPE and return a list describing the
    variants of QUAL_UNION_TYPE that are still relevant after applying
-   the substitutions described in SUBST_LIST.  VARIANT_LIST is a
-   pre-existing VEC onto which newly created entries should be
-   pushed.  */
+   the substitutions described in SUBST_LIST.  GNU_LIST is a pre-existing
+   list to be prepended to the newly created entries.  */
 
 static VEC(variant_desc,heap) *
 build_variant_list (tree qual_union_type, VEC(subst_pair,heap) *subst_list,
-		    VEC(variant_desc,heap) *variant_list)
+		    VEC(variant_desc,heap) *gnu_list)
 {
   tree gnu_field;
 
@@ -7554,10 +7545,10 @@  build_variant_list (tree qual_union_type
        gnu_field = DECL_CHAIN (gnu_field))
     {
       tree qual = DECL_QUALIFIER (gnu_field);
-      unsigned ix;
+      unsigned int i;
       subst_pair *s;
 
-      FOR_EACH_VEC_ELT_REVERSE (subst_pair, subst_list, ix, s)
+      FOR_EACH_VEC_ELT (subst_pair, subst_list, i, s)
 	qual = SUBSTITUTE_IN_EXPR (qual, s->discriminant, s->replacement);
 
       /* If the new qualifier is not unconditionally false, its variant may
@@ -7567,7 +7558,7 @@  build_variant_list (tree qual_union_type
 	  variant_desc *v;
 	  tree variant_type = TREE_TYPE (gnu_field), variant_subpart;
 
-	  v = VEC_safe_push (variant_desc, heap, variant_list, NULL);
+	  v = VEC_safe_push (variant_desc, heap, gnu_list, NULL);
 	  v->type = variant_type;
 	  v->field = gnu_field;
 	  v->qual = qual;
@@ -7576,8 +7567,8 @@  build_variant_list (tree qual_union_type
 	  /* Recurse on the variant subpart of the variant, if any.  */
 	  variant_subpart = get_variant_part (variant_type);
 	  if (variant_subpart)
-	    variant_list = build_variant_list (TREE_TYPE (variant_subpart),
-					       subst_list, variant_list);
+	    gnu_list = build_variant_list (TREE_TYPE (variant_subpart),
+					   subst_list, gnu_list);
 
 	  /* If the new qualifier is unconditionally true, the subsequent
 	     variants cannot be accessed.  */
@@ -7586,7 +7577,7 @@  build_variant_list (tree qual_union_type
 	}
     }
 
-  return variant_list;
+  return gnu_list;
 }
 
 /* UINT_SIZE is a Uint giving the specified size for an object of GNU_TYPE
@@ -8135,11 +8126,11 @@  create_field_decl_from (tree old_field,
   tree pos = TREE_VEC_ELT (t, 0), bitpos = TREE_VEC_ELT (t, 2);
   unsigned int offset_align = tree_low_cst (TREE_VEC_ELT (t, 1), 1);
   tree new_pos, new_field;
-  unsigned ix;
+  unsigned int i;
   subst_pair *s;
 
   if (CONTAINS_PLACEHOLDER_P (pos))
-    FOR_EACH_VEC_ELT_REVERSE (subst_pair, subst_list, ix, s)
+    FOR_EACH_VEC_ELT (subst_pair, subst_list, i, s)
       pos = SUBSTITUTE_IN_EXPR (pos, s->discriminant, s->replacement);
 
   /* If the position is now a constant, we can set it as the position of the
@@ -8243,7 +8234,7 @@  create_variant_part_from (tree old_varia
   tree new_union_type, new_variant_part;
   tree union_field_list = NULL_TREE;
   variant_desc *v;
-  unsigned ix;
+  unsigned int i;
 
   /* First create the type of the variant part from that of the old one.  */
   new_union_type = make_node (QUAL_UNION_TYPE);
@@ -8273,7 +8264,7 @@  create_variant_part_from (tree old_varia
     copy_and_substitute_in_size (new_union_type, old_union_type, subst_list);
 
   /* Now finish up the new variants and populate the union type.  */
-  FOR_EACH_VEC_ELT_REVERSE (variant_desc, variant_list, ix, v)
+  FOR_EACH_VEC_ELT_REVERSE (variant_desc, variant_list, i, v)
     {
       tree old_field = v->field, new_field;
       tree old_variant, old_variant_subpart, new_variant, field_list;
@@ -8317,7 +8308,8 @@  create_variant_part_from (tree old_varia
     }
 
   /* Finish up the union type and create the variant part.  No need for debug
-     info thanks to the XVS type.  */
+     info thanks to the XVS type.  Note that we don't reverse the field list
+     because VARIANT_LIST has been traversed in reverse order.  */
   finish_record_type (new_union_type, union_field_list, 2, false);
   compute_record_mode (new_union_type);
   create_type_decl (TYPE_NAME (new_union_type), new_union_type, NULL,
@@ -8356,7 +8348,7 @@  static void
 copy_and_substitute_in_size (tree new_type, tree old_type,
 			     VEC(subst_pair,heap) *subst_list)
 {
-  unsigned ix;
+  unsigned int i;
   subst_pair *s;
 
   TYPE_SIZE (new_type) = TYPE_SIZE (old_type);
@@ -8366,19 +8358,19 @@  copy_and_substitute_in_size (tree new_ty
   relate_alias_sets (new_type, old_type, ALIAS_SET_COPY);
 
   if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE (new_type)))
-    FOR_EACH_VEC_ELT_REVERSE (subst_pair, subst_list, ix, s)
+    FOR_EACH_VEC_ELT (subst_pair, subst_list, i, s)
       TYPE_SIZE (new_type)
 	= SUBSTITUTE_IN_EXPR (TYPE_SIZE (new_type),
 			      s->discriminant, s->replacement);
 
   if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE_UNIT (new_type)))
-    FOR_EACH_VEC_ELT_REVERSE (subst_pair, subst_list, ix, s)
+    FOR_EACH_VEC_ELT (subst_pair, subst_list, i, s)
       TYPE_SIZE_UNIT (new_type)
 	= SUBSTITUTE_IN_EXPR (TYPE_SIZE_UNIT (new_type),
 			      s->discriminant, s->replacement);
 
   if (CONTAINS_PLACEHOLDER_P (TYPE_ADA_SIZE (new_type)))
-    FOR_EACH_VEC_ELT_REVERSE (subst_pair, subst_list, ix, s)
+    FOR_EACH_VEC_ELT (subst_pair, subst_list, i, s)
       SET_TYPE_ADA_SIZE
 	(new_type, SUBSTITUTE_IN_EXPR (TYPE_ADA_SIZE (new_type),
 				       s->discriminant, s->replacement));
Index: gcc-interface/utils2.c
===================================================================
--- gcc-interface/utils2.c	(revision 188377)
+++ gcc-interface/utils2.c	(working copy)
@@ -2287,7 +2287,7 @@  build_allocator (tree type, tree init, t
 
       /* If the size overflows, pass -1 so Storage_Error will be raised.  */
       if (TREE_CODE (size) == INTEGER_CST && TREE_OVERFLOW (size))
-	size = ssize_int (-1);
+	size = size_int (-1);
 
       storage = build_call_alloc_dealloc (NULL_TREE, size, storage_type,
 					  gnat_proc, gnat_pool, gnat_node);
@@ -2345,7 +2345,7 @@  build_allocator (tree type, tree init, t
 
   /* If the size overflows, pass -1 so Storage_Error will be raised.  */
   if (TREE_CODE (size) == INTEGER_CST && TREE_OVERFLOW (size))
-    size = ssize_int (-1);
+    size = size_int (-1);
 
   storage = convert (result_type,
 		     build_call_alloc_dealloc (NULL_TREE, size, type,