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

2007-06-24  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/32298
	PR fortran/31726
	* 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-06-24  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/31726
	* gfortran.dg/minmaxloc_1.f90: New test.

	PR fortran/32298
	* gfortran.dg/minmaxloc_2.f90: New test.

From-SVN: r125983

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index d0cbd0a8af7900736db7a05661a5ee5261e97347..e3876fc3ab0b3be10ff409189ac100f39243fb9c 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,13 @@
+2007-06-24  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/32298
+       PR fortran/31726
+       * 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-06-22  Daniel Franke  <franke.daniel@gmail.com>
 
        PR fortran/31473

diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index d1c371092fb33cf178e97c5099a5257799ac6169..874b1081de668d91aafed493e7f326dac7b85b4b 100644 (file)
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -1928,6 +1928,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;
@@ -1947,6 +1948,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.  */
@@ -2045,15 +2047,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);
 
@@ -2098,12 +2113,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 5fbc1331cb290f73d548f52f04d58849ec164842..17bddb1a54a744e81365262cd97b732bef977959 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2007-06-24  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/31726
+       * gfortran.dg/minmaxloc_1.f90: New test.
+
+       PR fortran/32298
+       * gfortran.dg/minmaxloc_2.f90: New test.
+
 2007-06-23  Mark Mitchell  <mark@codesourcery.com>
 
        * gcc.dg/visibility-12.c: New test.

diff --git a/gcc/testsuite/gfortran.dg/minmaxloc_1.f90 b/gcc/testsuite/gfortran.dg/minmaxloc_1.f90
new file mode 100644 (file)
index 0000000..fcdf795
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/minmaxloc_1.f90
@@ -0,0 +1,118 @@
+! { dg-do run }
+! Check max/minloc.
+! PR fortran/31726
+!
+program test
+  implicit none
+  integer :: i(1), j(-1:1), res(1)
+  logical, volatile :: m(3), m2(3)
+  m = (/ .false., .false., .false. /)
+  m2 = (/ .false., .true., .false. /)
+  call check(1, 0, MAXLOC((/ 42, 23, 11 /), DIM=1, MASK=.FALSE.))
+  call check(2, 0, MAXLOC((/ 42, 23, 11 /), DIM=1, MASK=m))
+  call check(3, 2, MAXLOC((/ 42, 23, 11 /), DIM=1, MASK=m2))
+  call check(4, 0, MAXLOC(i(1:0), DIM=1, MASK=.TRUE.))
+  call check(5, 0, MAXLOC(i(1:0), DIM=1, MASK=.FALSE.))
+  call check(6, 0, MAXLOC(i(1:0), DIM=1, MASK=m(1:0)))
+  call check(7, 0, MAXLOC(i(1:0), DIM=1))
+  call check(8, 0, MINLOC((/ 42, 23, 11 /), DIM=1, MASK=.FALSE.))
+  call check(9, 0, MINLOC((/ 42, 23, 11 /), DIM=1, MASK=m))
+  call check(10, 0, MINLOC(i(1:0), DIM=1, MASK=.FALSE.))
+  call check(11,0, MINLOC(i(1:0), DIM=1, MASK=m(1:0)))
+  call check(12,0, MINLOC(i(1:0), DIM=1, MASK=.TRUE.))
+  call check(13,0, MINLOC(i(1:0), DIM=1))
+
+  j = (/ 1, 2, 1 /); call check(14, 2, MAXLOC(j, DIM=1))
+  j = (/ 1, 2, 3 /); call check(15, 3, MAXLOC(j, DIM=1))
+  j = (/ 3, 2, 1 /); call check(16, 1, MAXLOC(j, DIM=1))
+  j = (/ 1, 2, 1 /); call check(17, 1, MINLOC(j, DIM=1))
+  j = (/ 1, 2, 3 /); call check(18, 1, MINLOC(j, DIM=1))
+  j = (/ 3, 2, 1 /); call check(19, 3, MINLOC(j, DIM=1))
+
+  j = (/ 1, 2, 1 /); call check(20, 2, MAXLOC(j, DIM=1,mask=.true.))
+  j = (/ 1, 2, 3 /); call check(21, 3, MAXLOC(j, DIM=1,mask=.true.))
+  j = (/ 3, 2, 1 /); call check(22, 1, MAXLOC(j, DIM=1,mask=.true.))
+  j = (/ 1, 2, 1 /); call check(23, 1, MINLOC(j, DIM=1,mask=.true.))
+  j = (/ 1, 2, 3 /); call check(24, 1, MINLOC(j, DIM=1,mask=.true.))
+  j = (/ 3, 2, 1 /); call check(25, 3, MINLOC(j, DIM=1,mask=.true.))
+
+  j = (/ 1, 2, 1 /); call check(26, 0, MAXLOC(j, DIM=1,mask=.false.))
+  j = (/ 1, 2, 3 /); call check(27, 0, MAXLOC(j, DIM=1,mask=.false.))
+  j = (/ 3, 2, 1 /); call check(28, 0, MAXLOC(j, DIM=1,mask=.false.))
+  j = (/ 1, 2, 1 /); call check(29, 0, MINLOC(j, DIM=1,mask=.false.))
+  j = (/ 1, 2, 3 /); call check(30, 0, MINLOC(j, DIM=1,mask=.false.))
+  j = (/ 3, 2, 1 /); call check(31, 0, MINLOC(j, DIM=1,mask=.false.))
+
+  j = (/ 1, 2, 1 /); call check(32, 0, MAXLOC(j, DIM=1,mask=m))
+  j = (/ 1, 2, 3 /); call check(33, 0, MAXLOC(j, DIM=1,mask=m))
+  j = (/ 3, 2, 1 /); call check(34, 0, MAXLOC(j, DIM=1,mask=m))
+  j = (/ 1, 2, 1 /); call check(35, 0, MINLOC(j, DIM=1,mask=m))
+  j = (/ 1, 2, 3 /); call check(36, 0, MINLOC(j, DIM=1,mask=m))
+  j = (/ 3, 2, 1 /); call check(37, 0, MINLOC(j, DIM=1,mask=m))
+
+  j = (/ 1, 2, 1 /); call check(38, 2, MAXLOC(j, DIM=1,mask=m2))
+  j = (/ 1, 2, 3 /); call check(39, 2, MAXLOC(j, DIM=1,mask=m2))
+  j = (/ 3, 2, 1 /); call check(40, 2, MAXLOC(j, DIM=1,mask=m2))
+  j = (/ 1, 2, 1 /); call check(41, 2, MINLOC(j, DIM=1,mask=m2))
+  j = (/ 1, 2, 3 /); call check(42, 2, MINLOC(j, DIM=1,mask=m2))
+  j = (/ 3, 2, 1 /); call check(43, 2, MINLOC(j, DIM=1,mask=m2))
+
+! Check the library minloc and maxloc
+  res = MAXLOC((/ 42, 23, 11 /), MASK=.FALSE.); call check(44, 0,  res(1))
+  res = MAXLOC((/ 42, 23, 11 /), MASK=m); call check(45, 0,  res(1))
+  res = MAXLOC((/ 42, 23, 11 /), MASK=m2); call check(46, 2,  res(1))
+  res = MAXLOC(i(1:0), MASK=.TRUE.); call check(47, 0,  res(1))
+  res = MAXLOC(i(1:0), MASK=.FALSE.); call check(48, 0,  res(1))
+  res = MAXLOC(i(1:0), MASK=m(1:0)); call check(49, 0,  res(1))
+  res = MAXLOC(i(1:0)); call check(50, 0,  res(1))
+  res = MINLOC((/ 42, 23, 11 /), MASK=.FALSE.); call check(51, 0, res(1))
+  res = MINLOC((/ 42, 23, 11 /), MASK=m); call check(52, 0, res(1))
+  res = MINLOC(i(1:0), MASK=.FALSE.); call check(53, 0, res(1))
+  res = MINLOC(i(1:0), MASK=m(1:0)); call check(54,0, res(1))
+  res = MINLOC(i(1:0), MASK=.TRUE.); call check(55,0, res(1))
+  res = MINLOC(i(1:0)); call check(56,0, res(1))
+
+  j = (/ 1, 2, 1 /); res = MAXLOC(j); call check(57, 2,  res(1))
+  j = (/ 1, 2, 3 /); res = MAXLOC(j); call check(58, 3,  res(1))
+  j = (/ 3, 2, 1 /); res = MAXLOC(j); call check(59, 1,  res(1))
+  j = (/ 1, 2, 1 /); res = MINLOC(j); call check(60, 1, res(1))
+  j = (/ 1, 2, 3 /); res = MINLOC(j); call check(61, 1, res(1))
+  j = (/ 3, 2, 1 /); res = MINLOC(j); call check(62, 3, res(1))
+
+  j = (/ 1, 2, 1 /); res = MAXLOC(j,mask=.true.); call check(63, 2,  res(1))
+  j = (/ 1, 2, 3 /); res = MAXLOC(j,mask=.true.); call check(65, 3,  res(1))
+  j = (/ 3, 2, 1 /); res = MAXLOC(j,mask=.true.); call check(66, 1,  res(1))
+  j = (/ 1, 2, 1 /); res = MINLOC(j,mask=.true.); call check(67, 1, res(1))
+  j = (/ 1, 2, 3 /); res = MINLOC(j,mask=.true.); call check(68, 1, res(1))
+  j = (/ 3, 2, 1 /); res = MINLOC(j,mask=.true.); call check(69, 3, res(1))
+
+  j = (/ 1, 2, 1 /); res = MAXLOC(j,mask=.false.); call check(70, 0,  res(1))
+  j = (/ 1, 2, 3 /); res = MAXLOC(j,mask=.false.); call check(71, 0,  res(1))
+  j = (/ 3, 2, 1 /); res = MAXLOC(j,mask=.false.); call check(72, 0,  res(1))
+  j = (/ 1, 2, 1 /); res = MINLOC(j,mask=.false.); call check(73, 0, res(1))
+  j = (/ 1, 2, 3 /); res = MINLOC(j,mask=.false.); call check(74, 0, res(1))
+  j = (/ 3, 2, 1 /); res = MINLOC(j,mask=.false.); call check(75, 0, res(1))
+
+  j = (/ 1, 2, 1 /); res = MAXLOC(j,mask=m); call check(76, 0,  res(1))
+  j = (/ 1, 2, 3 /); res = MAXLOC(j,mask=m); call check(77, 0,  res(1))
+  j = (/ 3, 2, 1 /); res = MAXLOC(j,mask=m); call check(78, 0,  res(1))
+  j = (/ 1, 2, 1 /); res = MINLOC(j,mask=m); call check(79, 0, res(1))
+  j = (/ 1, 2, 3 /); res = MINLOC(j,mask=m); call check(80, 0, res(1))
+  j = (/ 3, 2, 1 /); res = MINLOC(j,mask=m);call check(81, 0, res(1))
+
+  j = (/ 1, 2, 1 /); res = MAXLOC(j,mask=m2); call check(82, 2,  res(1))
+  j = (/ 1, 2, 3 /); res = MAXLOC(j,mask=m2); call check(83, 2,  res(1))
+  j = (/ 3, 2, 1 /); res = MAXLOC(j,mask=m2); call check(84, 2,  res(1))
+  j = (/ 1, 2, 1 /); res = MINLOC(j,mask=m2); call check(85, 2, res(1))
+  j = (/ 1, 2, 3 /); res = MINLOC(j,mask=m2); call check(86, 2, res(1))
+  j = (/ 3, 2, 1 /); res = MINLOC(j,mask=m2); call check(87, 2, res(1))
+
+contains
+subroutine check(n, i,j)
+  integer, value, intent(in) :: i,j,n
+  if(i /= j) then
+     call abort()
+!    print *, 'ERROR: Test',n,' expected ',i,' received ', j
+  end if
+end subroutine check
+end program

diff --git a/gcc/testsuite/gfortran.dg/minmaxloc_2.f90 b/gcc/testsuite/gfortran.dg/minmaxloc_2.f90
new file mode 100644 (file)
index 0000000..a4fd7ae
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/minmaxloc_2.f90
@@ -0,0 +1,29 @@
+! { dg-do run }
+! Tests the fix for PR32298, in which the scalarizer would generate
+! a temporary in the course of evaluating MINLOC or MAXLOC, thereby
+! setting the start of the scalarizer loop to zero.
+!
+! Contributed by Jens Bischoff <jens.bischoff@freenet.de> 
+!
+PROGRAM ERR_MINLOC
+
+   INTEGER, PARAMETER :: N = 7
+
+   DOUBLE PRECISION, DIMENSION (N), PARAMETER :: A &
+     = (/ 0.3D0, 0.455D0, 0.6D0, 0.7D0, 0.72D0, 0.76D0, 0.79D0 /)
+
+   DOUBLE PRECISION :: B
+   INTEGER          :: I, J(N), K(N)
+
+  DO I = 1, N
+    B = A(I)
+    J(I) = MINLOC (ABS (A - B), 1)
+    K(I) = MAXLOC (ABS (A - B), 1)
+  END DO
+
+  if (any (J .NE. (/1,2,3,4,5,6,7/))) call abort ()
+  if (any (K .NE. (/7,7,1,1,1,1,1/))) call abort ()
+
+  STOP
+
+END PROGRAM ERR_MINLOC