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

5 files changed, 92 insertions, 36 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index a81141f..6ebb660 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,24 @@
+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-28  Tobias Burnus  <burnus@net-b.de>
 
 	* intrinsic.texi: Update OpenMP section for OMPv3.
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;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index d910aa2..85e97f3 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,13 @@
+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.
+
 2008-10-30  Jakub Jelinek  <jakub@redhat.com>
 
 	* gcc.target/s390/pr36822.c: Avoid cast to pointer from integer
diff --git a/gcc/testsuite/gfortran.dg/vector_subscript_4.f90 b/gcc/testsuite/gfortran.dg/vector_subscript_4.f90
new file mode 100644
index 0000000..2044684
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/vector_subscript_4.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! Test the fix for PR37903, in which the temporary for the vector index
+! got the wrong size.
+!
+! Contributed by Mikael Morin <mikael.morin@tele2.fr>
+!
+     integer :: i(-1:1) = 1, j(3) = 1, k(3)
+      k = j((/1,1,1/)+i)
+      end
+! { dg-final { scan-tree-dump-times "A\.3\\\[3\\\]" 1 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/vector_subscript_5.f90 b/gcc/testsuite/gfortran.dg/vector_subscript_5.f90
new file mode 100644
index 0000000..88eb358
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/vector_subscript_5.f90
@@ -0,0 +1,26 @@
+! { dg-do run }
+!
+! Test the fix for PR37749 in which the expression in line 13 would cause an ICE
+! because the upper value of the loop range was not set.
+!
+! Contributed by Jakub Jelinek <jakub@gcc.gnu.org>
+!
+subroutine subr (m, n, a, b, c, d, p)
+  implicit none
+  integer m, n
+  real a(m,n), b(m,n), c(n,n), d(m,n)
+  integer p(n)
+  d = a(:,p) - matmul(b, c)
+end subroutine
+
+  implicit none
+  integer i
+  real a(3,2), b(3,2), c(2,2), d(3,2)
+  integer p(2)
+  a = reshape ((/(i, i = 1, 6)/), (/3, 2/))
+  b = 1
+  c = 2
+  p = 2
+  call subr (3, 2, a, b, c, d, p)
+  if (any (d .ne. reshape ((/(mod (i + 2, 3), i = 1, 6)/), (/3, 2/)))) call abort
+end