re PR fortran/37903 (wrong-code for complicated vector subscripts)

2008-10-30  Mikael Morin  <mikael.morin@tele2.fr>

        PR fortran/37903
        * trans-array.c (gfc_trans_create_temp_array): If n is less
	than the temporary dimension, assert that loop->from is
	zero (reverts to earlier versions). If there is at least one
	null loop->to[n], it is a callee allocated array so set the
	size to NULL and break.
	(gfc_trans_constant_array_constructor): Set the offset to zero.
	(gfc_trans_array_constructor): Remove loop shifting around the
	temporary creation.
	(gfc_conv_loop_setup): Prefer zero-based descriptors if
	possible.  Calculate the translation from loop variables to
	array indices if an array constructor.

2008-10-30  Mikael Morin  <mikael.morin@tele2.fr>

        PR fortran/37749
        * trans-array.c (gfc_trans_create_temp_array): If size is NULL
	use the array bounds for loop->to.

2008-10-30  Mikael Morin  <mikael.morin@tele2.fr>

        PR fortran/37903
        * gfortran.dg/vector_subscript_4.f90: New test.

2008-10-30  Mikael Morin  <mikael.morin@tele2.fr>

        PR fortran/37749
        * gfortran.dg/vector_subscript__5.f90: New test.

From-SVN: r141467

1 files changed, 22 insertions, 36 deletions

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index c5aff65..5080e0f 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -595,9 +595,9 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
   for (dim = 0; dim < info->dimen; dim++)
     {
       n = loop->order[dim];
-      /* TODO: Investigate why "if (n < loop->temp_dim)
-	 gcc_assert (integer_zerop (loop->from[n]));" fails here.  */
-      if (n >= loop->temp_dim)
+      if (n < loop->temp_dim)
+      gcc_assert (integer_zerop (loop->from[n]));
+      else
 	{
 	  /* Callee allocated arrays may not have a known bound yet.  */
           if (loop->to[n])
@@ -642,9 +642,18 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
 
   or_expr = NULL_TREE;
 
+  /* If there is at least one null loop->to[n], it is a callee allocated 
+     array.  */
   for (n = 0; n < info->dimen; n++)
-    {
-      if (loop->to[n] == NULL_TREE)
+    if (loop->to[n] == NULL_TREE)
+      {
+	size = NULL_TREE;
+	break;
+      }
+
+  for (n = 0; n < info->dimen; n++)
+     {
+      if (size == NULL_TREE)
         {
 	  /* For a callee allocated array express the loop bounds in terms
 	     of the descriptor fields.  */
@@ -653,7 +662,6 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
 			 gfc_conv_descriptor_ubound (desc, gfc_rank_cst[n]),
 			 gfc_conv_descriptor_lbound (desc, gfc_rank_cst[n]));
           loop->to[n] = tmp;
-          size = NULL_TREE;
           continue;
         }
         
@@ -1628,8 +1636,7 @@ gfc_trans_constant_array_constructor (gfc_loopinfo * loop,
 
   info->descriptor = tmp;
   info->data = build_fold_addr_expr (tmp);
-  info->offset = fold_build1 (NEGATE_EXPR, gfc_array_index_type,
-			      loop->from[0]);
+  info->offset = gfc_index_zero_node;
 
   for (i = 0; i < info->dimen; i++)
     {
@@ -1692,7 +1699,6 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where)
   tree offsetvar;
   tree desc;
   tree type;
-  tree loopfrom;
   bool dynamic;
   bool old_first_len, old_typespec_chararray_ctor;
   tree old_first_len_val;
@@ -1804,34 +1810,9 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where)
 	}
     }
 
-  /* Temporarily reset the loop variables, so that the returned temporary
-     has the right size and bounds.  This seems only to be necessary for
-     1D arrays.  */
-  if (!integer_zerop (loop->from[0]) && loop->dimen == 1)
-    {
-      loopfrom = loop->from[0];
-      loop->from[0] = gfc_index_zero_node;
-      loop->to[0] = fold_build2 (MINUS_EXPR, gfc_array_index_type,
-				 loop->to[0], loopfrom);
-    }
-  else
-    loopfrom = NULL_TREE;
-
   gfc_trans_create_temp_array (&loop->pre, &loop->post, loop, &ss->data.info,
 			       type, dynamic, true, false, where);
 
-  if (loopfrom != NULL_TREE)
-    {
-      loop->from[0] = loopfrom;
-      loop->to[0] = fold_build2 (PLUS_EXPR, gfc_array_index_type,
-				 loop->to[0], loopfrom);
-      /* In the case of a non-zero from, the temporary needs an offset
-	 so that subsequent indexing is correct.  */
-      ss->data.info.offset = fold_build1 (NEGATE_EXPR,
-					  gfc_array_index_type,
-					  loop->from[0]);
-    }
-
   desc = ss->data.info.descriptor;
   offset = gfc_index_zero_node;
   offsetvar = gfc_create_var_np (gfc_array_index_type, "offset");
@@ -3379,7 +3360,10 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
 	  if (ss->shape)
 	    {
 	      /* The frontend has worked out the size for us.  */
-	      loopspec[n] = ss;
+	      if (!loopspec[n] || !loopspec[n]->shape
+		    || !integer_zerop (loopspec[n]->data.info.start[n]))
+		/* Prefer zero-based descriptors if possible.  */
+		loopspec[n] = ss;
 	      continue;
 	    }
 
@@ -3556,7 +3540,9 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
   /* Calculate the translation from loop variables to array indices.  */
   for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
     {
-      if (ss->type != GFC_SS_SECTION && ss->type != GFC_SS_COMPONENT)
+      if (ss->type != GFC_SS_SECTION && ss->type != GFC_SS_COMPONENT
+	    && ss->type != GFC_SS_CONSTRUCTOR)
+
 	continue;
 
       info = &ss->data.info;