[gfortran,patch] Fix allocation of temporaries having negative extent

["François-Xavier Coudert" <fxcoudert at gmail dot com>]

:ADDPATCH fortran:

Attached patch fixes PR30720, where we ask the front-end to generate
code to allocate an array that has negative extent in one dimension.
Having negative extent is strictly equivalent to having zero extent,
so we should explicitly check and correct this case (I've been doing
that already in many other places, so I assume that parts of the
front-end code were originally written with the assumption that
negative extents never happened :)

Also, I simplified the original code (by Thomas K.) because I think a
COND_EXPR is less heavy than generating different blocks.

Bootstrapped & regtested on i686-linux, will come with a testcase from
the PR. OK for mainline and 4.2?

FX

Attachment: pr30720.ChangeLog
Description: Binary data

Index: trans-array.c
===================================================================
--- trans-array.c	(revision 121506)
+++ trans-array.c	(working copy)
@@ -583,7 +583,7 @@
 gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
 			     gfc_loopinfo * loop, gfc_ss_info * info,
 			     tree eltype, bool dynamic, bool dealloc,
-			     bool callee_alloc, bool function)
+			     bool callee_alloc)
 {
   tree type;
   tree desc;
@@ -592,11 +592,6 @@
   tree nelem;
   tree cond;
   tree or_expr;
-  tree thencase;
-  tree elsecase;
-  tree var;
-  stmtblock_t thenblock;
-  stmtblock_t elseblock;
   int n;
   int dim;
 
@@ -678,19 +673,16 @@
       tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type,
 			 loop->to[n], gfc_index_one_node);
 
-      if (function)
-	{
-	  /* Check whether the size for this dimension is negative.  */
-	  cond = fold_build2 (LE_EXPR, boolean_type_node, tmp,
+      /* Check whether the size for this dimension is negative.  */
+      cond = fold_build2 (LE_EXPR, boolean_type_node, tmp,
 			  gfc_index_zero_node);
+      cond = gfc_evaluate_now (cond, pre);
 
-	  cond = gfc_evaluate_now (cond, pre);
+      if (n == 0)
+	or_expr = cond;
+      else
+	or_expr = fold_build2 (TRUTH_OR_EXPR, boolean_type_node, or_expr, cond);
 
-	  if (n == 0)
-	    or_expr = cond;
-	  else
-	    or_expr = fold_build2 (TRUTH_OR_EXPR, boolean_type_node, or_expr, cond);
-	}
       size = fold_build2 (MULT_EXPR, gfc_array_index_type, size, tmp);
       size = gfc_evaluate_now (size, pre);
     }
@@ -699,34 +691,11 @@
 
   if (size && !callee_alloc)
     {
-      if (function)
-	{
-	  /* If we know at compile-time whether any dimension size is
-	     negative, we can avoid a conditional and pass the true size
-	     to gfc_trans_allocate_array_storage, which can then decide
-	     whether to allocate this on the heap or on the stack.  */
-	  if (integer_zerop (or_expr))
-	    ;
-	  else if (integer_onep (or_expr))
-	    size = gfc_index_zero_node;
-	  else
-	    {
-	      var = gfc_create_var (TREE_TYPE (size), "size");
-	      gfc_start_block (&thenblock);
-	      gfc_add_modify_expr (&thenblock, var, gfc_index_zero_node);
-	      thencase = gfc_finish_block (&thenblock);
+      /* If or_expr is true, then the extent in at least one
+	 dimension is zero and the size is set to zero.  */
+      size = fold_build3 (COND_EXPR, gfc_array_index_type,
+			  or_expr, gfc_index_zero_node, size);
 
-	      gfc_start_block (&elseblock);
-	      gfc_add_modify_expr (&elseblock, var, size);
-	      elsecase = gfc_finish_block (&elseblock);
-	  
-	      tmp = gfc_evaluate_now (or_expr, pre);
-	      tmp = build3_v (COND_EXPR, tmp, thencase, elsecase);
-	      gfc_add_expr_to_block (pre, tmp);
-	      size = var;
-	    }
-	}
-
       nelem = size;
       size = fold_build2 (MULT_EXPR, gfc_array_index_type, size,
 			  TYPE_SIZE_UNIT (gfc_get_element_type (type)));
@@ -1647,7 +1617,7 @@
     }
 
   gfc_trans_create_temp_array (&loop->pre, &loop->post, loop, &ss->data.info,
-			       type, dynamic, true, false, false);
+			       type, dynamic, true, false);
 
   desc = ss->data.info.descriptor;
   offset = gfc_index_zero_node;
@@ -3241,7 +3211,7 @@
       loop->temp_ss->data.info.dimen = n;
       gfc_trans_create_temp_array (&loop->pre, &loop->post, loop,
 				   &loop->temp_ss->data.info, tmp, false, true,
-				   false, false);
+				   false);
     }
 
   for (n = 0; n < loop->temp_dim; n++)
Index: trans-array.h
===================================================================
--- trans-array.h	(revision 121506)
+++ trans-array.h	(working copy)
@@ -32,7 +32,7 @@
 
 /* Generate code to create a temporary array.  */
 tree gfc_trans_create_temp_array (stmtblock_t *, stmtblock_t *, gfc_loopinfo *,
-                                  gfc_ss_info *, tree, bool, bool, bool, bool);
+                                  gfc_ss_info *, tree, bool, bool, bool);
 
 /* Generate function entry code for allocation of compiler allocated array
    variables.  */
Index: trans-expr.c
===================================================================
--- trans-expr.c	(revision 121506)
+++ trans-expr.c	(working copy)
@@ -2332,8 +2332,7 @@
 	     mustn't be deallocated.  */
 	  callee_alloc = sym->attr.allocatable || sym->attr.pointer;
 	  gfc_trans_create_temp_array (&se->pre, &se->post, se->loop, info, tmp,
-				       false, !sym->attr.pointer, callee_alloc,
-				       true);
+				       false, !sym->attr.pointer, callee_alloc);
 
 	  /* Pass the temporary as the first argument.  */
 	  tmp = info->descriptor;
Index: trans-intrinsic.c
===================================================================
--- trans-intrinsic.c	(revision 121581)
+++ trans-intrinsic.c	(working copy)
@@ -2975,10 +2975,12 @@
   se->loop->to[n] = upper;
 
   /* Build a destination descriptor, using the pointer, source, as the
-     data field.  This is already allocated so set callee_alloc.  */
+     data field.  This is already allocated so set callee_alloc.
+     FIXME callee_alloc is not set!  */
+ 
   tmp = gfc_typenode_for_spec (&expr->ts);
   gfc_trans_create_temp_array (&se->pre, &se->post, se->loop,
-			       info, tmp, false, true, false, false);
+			       info, tmp, false, true, false);
 
   /* Use memcpy to do the transfer.  */
   tmp = gfc_conv_descriptor_data_get (info->descriptor);
Index: trans-stmt.c
===================================================================
--- trans-stmt.c	(revision 121506)
+++ trans-stmt.c	(working copy)
@@ -268,7 +268,7 @@
 	  tmp = gfc_typenode_for_spec (&e->ts);
 	  tmp = gfc_trans_create_temp_array (&se->pre, &se->post,
 					      &tmp_loop, info, tmp,
-					      false, true, false, false);
+					      false, true, false);
 	  gfc_add_modify_expr (&se->pre, size, tmp);
 	  tmp = fold_convert (pvoid_type_node, info->data);
 	  gfc_add_modify_expr (&se->pre, data, tmp);