re PR fortran/32298 (MINLOC / MAXLOC: off-by one for PARAMETER arrays)

2007-10-25  Thomas Koenig  <tkoenig@gcc.gnu.org>
	    Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/32298
	PR fortran/31726
	PR fortran/33354
	Backport from trunk
	* trans-intrinsic.c (gfc_conv_intrinsic_minmaxloc): Calculate
	the offset between the loop counter and the position as
	defined. Add the offset within the loop so that the mask acts
	correctly.  Do not advance the location on the basis that it
	is zero.

2007-10-15  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/33354
	* gfortran.dg/minmaxloc_4.f90:  New test.

Co-Authored-By: Paul Thomas <pault@gcc.gnu.org>
From-SVN: r129365

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index ed6cb2115223e8ceb6db3a5b960c5d0f1ce44be6..995fe11dd4da6de2da55bc7a9f1fb17f2ffddfa6 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,16 @@
+2007-10-25  Thomas Koenig  <tkoenig@gcc.gnu.org>
+           Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/32298
+       PR fortran/31726
+       PR fortran/33354
+       Backport from trunk
+       * trans-intrinsic.c (gfc_conv_intrinsic_minmaxloc): Calculate
+       the offset between the loop counter and the position as
+       defined. Add the offset within the loop so that the mask acts
+       correctly.  Do not advance the location on the basis that it
+       is zero.
+
 2007-10-07  Release Manager
 
        * GCC 4.2.2 released.

diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 723fb245ea7b2b760bc6337391c7e16f45c2ed27..f6657cd406a9712dcef1c21a31d2ba101ec567de 100644 (file)
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -1878,6 +1878,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, int op)
   tree tmp;
   tree elsetmp;
   tree ifbody;
+  tree offset;
   gfc_loopinfo loop;
   gfc_actual_arglist *actual;
   gfc_ss *arrayss;
@@ -1897,6 +1898,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, int op)
 
   /* Initialize the result.  */
   pos = gfc_create_var (gfc_array_index_type, "pos");
+  offset = gfc_create_var (gfc_array_index_type, "offset");
   type = gfc_typenode_for_spec (&expr->ts);
 
   /* Walk the arguments.  */
@@ -1995,15 +1997,28 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, int op)
   /* Assign the value to the limit...  */
   gfc_add_modify_expr (&ifblock, limit, arrayse.expr);
 
-  /* Remember where we are.  */
-  gfc_add_modify_expr (&ifblock, pos, loop.loopvar[0]);
+  /* Remember where we are.  An offset must be added to the loop
+     counter to obtain the required position.  */
+  if (loop.temp_dim)
+    tmp = build_int_cst (gfc_array_index_type, 1);
+  else
+    tmp =fold_build2 (MINUS_EXPR, gfc_array_index_type,
+                        gfc_index_one_node, loop.from[0]);
+  gfc_add_modify_expr (&block, offset, tmp);
+
+  tmp = build2 (PLUS_EXPR, TREE_TYPE (pos),
+               loop.loopvar[0], offset);
+  gfc_add_modify_expr (&ifblock, pos, tmp);
 
   ifbody = gfc_finish_block (&ifblock);
 
-  /* If it is a more extreme value or pos is still zero.  */
+  /* If it is a more extreme value or pos is still zero and the value
+     equal to the limit.  */
+  tmp = build2 (TRUTH_AND_EXPR, boolean_type_node,
+               build2 (EQ_EXPR, boolean_type_node, pos, gfc_index_zero_node),
+               build2 (EQ_EXPR, boolean_type_node, arrayse.expr, limit));
   tmp = build2 (TRUTH_OR_EXPR, boolean_type_node,
-                 build2 (op, boolean_type_node, arrayse.expr, limit),
-                 build2 (EQ_EXPR, boolean_type_node, pos, gfc_index_zero_node));
+               build2 (op, boolean_type_node, arrayse.expr, limit), tmp);
   tmp = build3_v (COND_EXPR, tmp, ifbody, build_empty_stmt ());
   gfc_add_expr_to_block (&block, tmp);
 
@@ -2048,12 +2063,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, int op)
     }
   gfc_cleanup_loop (&loop);
 
-  /* Return a value in the range 1..SIZE(array).  */
-  tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, loop.from[0],
-                    gfc_index_one_node);
-  tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, pos, tmp);
-  /* And convert to the required type.  */
-  se->expr = convert (type, tmp);
+  se->expr = convert (type, pos);
 }
 
 static void

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 6de4856501f7c05d129b70c62972f003e8742365..7f93bf081592f665a7322ff40a579dd6ac648cb9 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2007-10-15  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       PR fortran/33354
+       * gfortran.dg/minmaxloc_4.f90:  New test.
+
 2007-10-13  Simon Martin  <simartin@users.sourceforge.net>
 
        PR c++/26698

diff --git a/gcc/testsuite/gfortran.dg/minmaxloc_4.f90 b/gcc/testsuite/gfortran.dg/minmaxloc_4.f90
new file mode 100644 (file)
index 0000000..2ea2e7b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/minmaxloc_4.f90
@@ -0,0 +1,21 @@
+! { dg-do run }
+! Test to make sure that PR 33354 remains fixed and doesn't regress
+PROGRAM TST
+  IMPLICIT NONE
+  REAL :: A(1,3)
+  REAL :: B(3,1)
+  A(:,1) = 10
+  A(:,2) = 20
+  A(:,3) = 30
+
+  !WRITE(*,*) SUM(A(:,1:3),1)
+  !WRITE(*,*) MINLOC(SUM(A(:,1:3),1),1)
+  if (minloc(sum(a(:,1:3),1),1) .ne. 1) call abort()
+  if (maxloc(sum(a(:,1:3),1),1) .ne. 3) call abort()
+
+  B(1,:) = 10
+  B(2,:) = 20
+  B(3,:) = 30
+  if (minloc(sum(b(1:3,:),2),2) .ne. 1) call abort()
+  if (maxloc(sum(b(1:3,:),2),2) .ne. 3) call abort()
+END PROGRAM TST