re PR fortran/30003 ([4.1 only] Expressions with side effects in array references)

2006-12-05  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/30003
	* trans-array.c (gfc_trans_create_temp_array): Set the section
	ends to zero.
	(gfc_conv_array_transpose): Likewise.
	(gfc_conv_section_startstride): Declare an expression for end,
	set it from a the array reference and evaluate it for the info
	structure. Zero the ends in the ss structure and set end, used
	in the bounds check, from the info structure.
	trans.h: Add and end array to the gfc_ss_info structure.

2006-12-05  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/30003
	* gfortran.dg/allocatable_function_1.f90: Increase the number
	of expected calls of free to 10; the lhs section reference is
	now evaluated so there is another call to bar.  Change the
	comment appropriately.
	* gfortran.dg/array_section_1.f90: New test.

From-SVN: r119556

1 files changed, 25 insertions, 1 deletions

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 0049ad5..bfd0600 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -618,6 +618,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
 
       info->delta[dim] = gfc_index_zero_node;
       info->start[dim] = gfc_index_zero_node;
+      info->end[dim] = gfc_index_zero_node;
       info->stride[dim] = gfc_index_one_node;
       info->dim[dim] = dim;
     }
@@ -783,6 +784,7 @@ gfc_conv_array_transpose (gfc_se * se, gfc_expr * expr)
     {
       dest_info->delta[n] = gfc_index_zero_node;
       dest_info->start[n] = gfc_index_zero_node;
+      dest_info->end[n] = gfc_index_zero_node;
       dest_info->stride[n] = gfc_index_one_node;
       dest_info->dim[n] = n;
 
@@ -2449,6 +2451,7 @@ static void
 gfc_conv_section_startstride (gfc_loopinfo * loop, gfc_ss * ss, int n)
 {
   gfc_expr *start;
+  gfc_expr *end;
   gfc_expr *stride;
   tree desc;
   gfc_se se;
@@ -2464,6 +2467,7 @@ gfc_conv_section_startstride (gfc_loopinfo * loop, gfc_ss * ss, int n)
     {
       /* We use a zero-based index to access the vector.  */
       info->start[n] = gfc_index_zero_node;
+      info->end[n] = gfc_index_zero_node;
       info->stride[n] = gfc_index_one_node;
       return;
     }
@@ -2471,6 +2475,7 @@ gfc_conv_section_startstride (gfc_loopinfo * loop, gfc_ss * ss, int n)
   gcc_assert (info->ref->u.ar.dimen_type[dim] == DIMEN_RANGE);
   desc = info->descriptor;
   start = info->ref->u.ar.start[dim];
+  end = info->ref->u.ar.end[dim];
   stride = info->ref->u.ar.stride[dim];
 
   /* Calculate the start of the range.  For vector subscripts this will
@@ -2490,6 +2495,24 @@ gfc_conv_section_startstride (gfc_loopinfo * loop, gfc_ss * ss, int n)
     }
   info->start[n] = gfc_evaluate_now (info->start[n], &loop->pre);
 
+  /* Similarly calculate the end.  Although this is not used in the
+     scalarizer, it is needed when checking bounds and where the end
+     is an expression with side-effects.  */
+  if (end)
+    {
+      /* Specified section start.  */
+      gfc_init_se (&se, NULL);
+      gfc_conv_expr_type (&se, end, gfc_array_index_type);
+      gfc_add_block_to_block (&loop->pre, &se.pre);
+      info->end[n] = se.expr;
+    }
+  else
+    {
+      /* No upper bound specified so use the bound of the array.  */
+      info->end[n] = gfc_conv_array_ubound (desc, dim);
+    }
+  info->end[n] = gfc_evaluate_now (info->end[n], &loop->pre);
+
   /* Calculate the stride.  */
   if (stride == NULL)
     info->stride[n] = gfc_index_one_node;
@@ -2582,6 +2605,7 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
 	  for (n = 0; n < ss->data.info.dimen; n++)
 	    {
 	      ss->data.info.start[n] = gfc_index_zero_node;
+	      ss->data.info.end[n] = gfc_index_zero_node;
 	      ss->data.info.stride[n] = gfc_index_one_node;
 	    }
 	  break;
@@ -2635,7 +2659,7 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
 	         than it is here, with all the trees.  */
 	      lbound = gfc_conv_array_lbound (desc, dim);
 	      ubound = gfc_conv_array_ubound (desc, dim);
-	      end = gfc_conv_section_upper_bound (ss, n, &block);
+	      end = info->end[n];
 
 	      /* Zero stride is not allowed.  */
 	      tmp = fold_build2 (EQ_EXPR, boolean_type_node, info->stride[n],