re PR fortran/21912 (Wrong implied do-loop)

fortran/
	PR fortran/21912
	* trans-array.c (gfc_trans_array_constructor_value): Slightly reorder.
	Generate correct exit condition in case of negative steps in
	implied-do loops.
testsuite/
	PR fortran/21912
	* gfortran.dg/array_constructor_4.f90: New test.

From-SVN: r100630

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 51afe9c2f6bfab07483d9f30d5ca4a56bbf6a765..9ee540598c1f81ac8d8bae0c4b7e45ee1ffa4a92 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,10 @@
 2005-06-05  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
 
+       PR fortran/21912
+       * trans-array.c (gfc_trans_array_constructor_value): Slightly reorder.
+       Generate correct exit condition in case of negative steps in
+       implied-do loops.
+
        * invoke.texi: Fix description of flags required for compatibility
        with g77.
 

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index fabbef99dc991ae53b4279eb978e70bc5ac3b871..3554107ab832dd41c8ebbca14f79b50a9517fca9 100644 (file)
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -721,7 +721,6 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type,
 {
   tree tmp;
   stmtblock_t body;
-  tree loopbody;
   gfc_se se;
 
   for (; c; c = c->next)
@@ -842,13 +841,23 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type,
             }
        }
 
-      /* The frontend should already have done any expansions.  */
-      if (c->iterator)
+      /* The frontend should already have done any expansions possible
+        at compile-time.  */
+      if (!c->iterator)
+       {
+         /* Pass the code as is.  */
+         tmp = gfc_finish_block (&body);
+         gfc_add_expr_to_block (pblock, tmp);
+       }
+      else
        {
+         /* Build the implied do-loop.  */
+         tree cond;
          tree end;
          tree step;
          tree loopvar;
          tree exit_label;
+         tree loopbody;
 
          loopbody = gfc_finish_block (&body);
 
@@ -877,17 +886,25 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type,
          exit_label = gfc_build_label_decl (NULL_TREE);
          gfc_start_block (&body);
 
-         /* Generate the exit condition.  */
-         end = build2 (GT_EXPR, boolean_type_node, loopvar, end);
+         /* Generate the exit condition.  Depending on the sign of
+            the step variable we have to generate the correct
+            comparison.  */
+         tmp = fold_build2 (GT_EXPR, boolean_type_node, step, 
+                            build_int_cst (TREE_TYPE (step), 0));
+         cond = fold_build3 (COND_EXPR, boolean_type_node, tmp,
+                             build2 (GT_EXPR, boolean_type_node,
+                                     loopvar, end),
+                             build2 (LT_EXPR, boolean_type_node,
+                                     loopvar, end));
          tmp = build1_v (GOTO_EXPR, exit_label);
          TREE_USED (exit_label) = 1;
-         tmp = build3_v (COND_EXPR, end, tmp, build_empty_stmt ());
+         tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ());
          gfc_add_expr_to_block (&body, tmp);
 
          /* The main loop body.  */
          gfc_add_expr_to_block (&body, loopbody);
 
-         /* Increment the loop variable.  */
+         /* Increase loop variable by step.  */
          tmp = build2 (PLUS_EXPR, TREE_TYPE (loopvar), loopvar, step);
          gfc_add_modify_expr (&body, loopvar, tmp);
 
@@ -900,12 +917,6 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type,
          tmp = build1_v (LABEL_EXPR, exit_label);
          gfc_add_expr_to_block (pblock, tmp);
        }
-      else
-       {
-         /* Pass the code as is.  */
-         tmp = gfc_finish_block (&body);
-         gfc_add_expr_to_block (pblock, tmp);
-       }
     }
 }
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 0fa5e70056f25f8d98d3e2ba23da04290ff3aa6a..96bc58183ab5c25e208567da06314c978efc7930 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2005-06-05  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+       PR fortran/21912
+       * gfortran.dg/array_constructor_4.f90: New test.
+
 2005-06-05  Mark Mitchell  <mark@codesourcery.com>
 
        PR c++/21619

diff --git a/gcc/testsuite/gfortran.dg/array_constructor_4.f90 b/gcc/testsuite/gfortran.dg/array_constructor_4.f90
new file mode 100644 (file)
index 0000000..cae6515
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_4.f90
@@ -0,0 +1,23 @@
+! { dg-do run }
+! PR 21912
+! We didn't adapt the exit condition to negative steps in array constructors,
+! leaving the resulting arrays uninitialized.
+integer :: i(5), n, m, l, k
+
+n = 5
+i = (/ (m, m = n, 1, -1) /)
+if (any (i /= (/ 5, 4, 3, 2, 1 /))) call abort
+
+k = 1
+
+i(5:1:-1) = (/ (m, m = n, k, -1) /)
+if (any (i /= (/ 1, 2, 3, 4, 5 /))) call abort
+
+l = -1
+
+i = (/ (m, m = n, 1, l) /)
+if (any (i /= (/ 5, 4, 3, 2, 1 /))) call abort
+
+i(5:1:-1) = (/ (m, m = n, k, l) /)
+if (any (i /= (/ 1, 2, 3, 4, 5 /))) call abort
+end