This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
Re: [Patch, fortran] PR31726 - minloc/maxloc: wrong results with empty array (F2003 only)
For some reason, the first attempt to send this picked up some mime content.
Tobias,
Please find attached a verson that works! Thomas' testcase is now included.
Bootstrapped and regtested on x86_ia64 - OK for trunk?
Paul
2007-06-23 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-23 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.
--
I love deadlines. I love the whooshing sound they make as they go by.
--Douglas Adams
Index: /svn/trunk/gcc/fortran/trans-intrinsic.c
===================================================================
--- /svn/trunk/gcc/fortran/trans-intrinsic.c (revision 125970)
+++ /svn/trunk/gcc/fortran/trans-intrinsic.c (working copy)
@@ -1928,6 +1928,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * s
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 * s
/* 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 * s
/* 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 * s
}
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
Index: /svn/trunk/gcc/testsuite/gfortran.dg/minmaxloc_1.f90
===================================================================
--- /svn/trunk/gcc/testsuite/gfortran.dg/minmaxloc_1.f90 (revision 0)
+++ /svn/trunk/gcc/testsuite/gfortran.dg/minmaxloc_1.f90 (revision 0)
@@ -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
Index: /svn/trunk/gcc/testsuite/gfortran.dg/minmaxloc_2.f90
===================================================================
--- /svn/trunk/gcc/testsuite/gfortran.dg/minmaxloc_2.f90 (revision 0)
+++ /svn/trunk/gcc/testsuite/gfortran.dg/minmaxloc_2.f90 (revision 0)
@@ -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