[Patch, fortran, RFC] PR28105 Overflow check for ALLOCATE statement

[Janne Blomqvist <blomqvist dot janne at gmail dot com>]

Hi,

the attached patch implements overflow checking for the ALLOCATE
statement. It also fixes the minor regression introduced a few days
ago when the old "< 0" overflow check was removed as a side-effect of
fixing the unsignedness of size_t.

Wrt whether these checks should be done always, or only when
-fcheck=mem is enabled, IMHO some benchmarks should be run and if no
difference can be seen they can be left enabled. So, does anybody know
of suitable benchmarks that are influenced by ALLOCATE performance?
Polyhedron, maybe not so much?

Regtested on x86_64-unknown-linux-gnu, and provided there is agreement
to always have it enabled, Ok for trunk?

2010-11-23  Janne Blomqvist  <jb@gcc.gnu.org>

	PR fortran/28105
	* trans-array.c (gfc_array_index_size): Check whether the size
	overflows.
	(gfc_array_allocate): Check whether size overflows and generate
	error.


-- 
Janne Blomqvist

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 3d5e5ba..dbd336c 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -3944,13 +3944,14 @@ gfc_conv_descriptor_size (tree desc, int rank)
 static tree
 gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
 		     gfc_expr ** lower, gfc_expr ** upper,
-		     stmtblock_t * pblock)
+		     stmtblock_t * pblock, tree * overflow)
 {
   tree type;
   tree tmp;
   tree size;
   tree offset;
   tree stride;
+  tree element_size;
   tree or_expr;
   tree thencase;
   tree elsecase;
@@ -4027,7 +4028,34 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
 
       /* Calculate size and check whether extent is negative.  */
       size = gfc_conv_array_extent_dim (conv_lbound, conv_ubound, &or_expr);
-
+      size = gfc_evaluate_now (size, pblock);
+
+      /* Check whether multiplying the stride by the number of
+	 elements in this dimension would overflow. We must also check
+	 whether the current dimension has zero size in order to avoid
+	 division by zero. The algorithm is thus
+
+	 overflow += size != 0 ? (M/size < stride ? 1: 0): 0;
+
+	 where M is the maximum value of gfc_array_index_type.
+      */
+      tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR, 
+			     gfc_array_index_type, 
+			     TYPE_MAX_VALUE (gfc_array_index_type), size);
+      tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node,
+			     fold_build2_loc (input_location, LT_EXPR, 
+					      boolean_type_node, tmp, stride),
+			     integer_one_node, integer_zero_node);
+      tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node,
+			     fold_build2_loc (input_location, NE_EXPR,
+					      boolean_type_node, size, 
+					      build_zero_cst (gfc_array_index_type)),
+			     tmp, integer_zero_node);
+      tmp = fold_build2_loc (input_location, PLUS_EXPR, integer_type_node,
+			     *overflow, tmp);
+      tmp = gfc_evaluate_now (tmp, pblock);
+      *overflow = tmp;
+      
       /* Multiply the stride by the number of elements in this dimension.  */
       stride = fold_build2_loc (input_location, MULT_EXPR,
 				gfc_array_index_type, stride, size);
@@ -4075,8 +4103,32 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
   /* The stride is the number of elements in the array, so multiply by the
      size of an element to get the total size.  */
   tmp = TYPE_SIZE_UNIT (gfc_get_element_type (type));
-  size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
-			  stride, fold_convert (gfc_array_index_type, tmp));
+  /* Convert to size_t.  */
+  element_size = fold_convert (sizetype, tmp);
+  stride = fold_convert (sizetype, stride);
+
+  /* First check for overflow. Since an array of type character can
+     have zero element_size, we must check for that before
+     dividing.  */
+  tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR, 
+			 sizetype, 
+			 TYPE_MAX_VALUE (sizetype), element_size);
+  tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node,
+			 fold_build2_loc (input_location, LT_EXPR, 
+					  boolean_type_node, tmp, stride),
+			 integer_one_node, integer_zero_node);
+  tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node,
+			 fold_build2_loc (input_location, NE_EXPR,
+					  boolean_type_node, element_size, 
+					  size_zero_node),
+			 tmp, integer_zero_node);
+  tmp = fold_build2_loc (input_location, PLUS_EXPR, integer_type_node,
+			 *overflow, tmp);
+  tmp = gfc_evaluate_now (tmp, pblock);
+  *overflow = tmp;
+
+  size = fold_build2_loc (input_location, MULT_EXPR, sizetype,
+			  stride, element_size);
 
   if (poffset != NULL)
     {
@@ -4091,7 +4143,7 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
 
   var = gfc_create_var (TREE_TYPE (size), "size");
   gfc_start_block (&thenblock);
-  gfc_add_modify (&thenblock, var, gfc_index_zero_node);
+  gfc_add_modify (&thenblock, var, size_zero_node);
   thencase = gfc_finish_block (&thenblock);
 
   gfc_start_block (&elseblock);
@@ -4117,6 +4169,12 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree pstat)
   tree pointer;
   tree offset;
   tree size;
+  tree msg;
+  tree error;
+  tree overflow; /* Boolean storing whether size calculation overflows.  */
+  tree var_overflow;
+  tree cond;
+  stmtblock_t elseblock;
   gfc_expr **lower;
   gfc_expr **upper;
   gfc_ref *ref, *prev_ref = NULL;
@@ -4184,21 +4242,60 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree pstat)
       break;
     }
 
+  overflow = integer_zero_node;
   size = gfc_array_init_size (se->expr, ref->u.ar.as->rank,
 			      ref->u.ar.as->corank, &offset, lower, upper,
-			      &se->pre);
+			      &se->pre, &overflow);
+
+  var_overflow = gfc_create_var (integer_type_node, "overflow");
+  gfc_add_modify (&se->pre, var_overflow, overflow);
+
+  /* Generate the block of code handling overflow.  */
+  msg = gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const
+  			("Integer overflow when calculating the amount of "
+  			 "memory to allocate"));
+  error = build_call_expr_loc (input_location,
+  			   gfor_fndecl_runtime_error, 1, msg);
+
+  if (pstat != NULL_TREE && !integer_zerop (pstat))
+    {
+      /* Set the status variable if it's present.  */
+      stmtblock_t set_status_block;
+      tree status_type = pstat ? TREE_TYPE (TREE_TYPE (pstat)) : NULL_TREE;
 
+      gfc_start_block (&set_status_block);
+      gfc_add_modify (&set_status_block,
+  		      fold_build1_loc (input_location, INDIRECT_REF,
+  				       status_type, pstat),
+  			   build_int_cst (status_type, LIBERROR_ALLOCATION));
+
+      tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
+  			     pstat, build_int_cst (TREE_TYPE (pstat), 0));
+      error = fold_build3_loc (input_location, COND_EXPR, void_type_node, tmp,
+  			       error, gfc_finish_block (&set_status_block));
+    }
+
+  gfc_start_block (&elseblock);
+  
   /* Allocate memory to store the data.  */
   pointer = gfc_conv_descriptor_data_get (se->expr);
   STRIP_NOPS (pointer);
 
   /* The allocate_array variants take the old pointer as first argument.  */
   if (allocatable_array)
-    tmp = gfc_allocate_array_with_status (&se->pre, pointer, size, pstat, expr);
+    tmp = gfc_allocate_array_with_status (&elseblock, pointer, size, pstat, expr);
   else
-    tmp = gfc_allocate_with_status (&se->pre, size, pstat);
+    tmp = gfc_allocate_with_status (&elseblock, size, pstat);
   tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, pointer,
 			 tmp);
+
+  gfc_add_expr_to_block (&elseblock, tmp);
+
+  cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+  			 var_overflow, integer_zero_node);
+  tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond, 
+			 error, gfc_finish_block (&elseblock));
+
   gfc_add_expr_to_block (&se->pre, tmp);
 
   gfc_conv_descriptor_offset_set (&se->pre, se->expr, offset);