From f0b3c58d8be622e7305c7d503a5d81b96b1db621 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Sun, 24 Jun 2007 11:04:02 +0000 Subject: [PATCH] re PR fortran/32298 (MINLOC / MAXLOC: off-by one for PARAMETER arrays) 2007-06-24 Paul Thomas 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 PR fortran/31726 * gfortran.dg/minmaxloc_1.f90: New test. PR fortran/32298 * gfortran.dg/minmaxloc_2.f90: New test. From-SVN: r125983 --- gcc/fortran/ChangeLog | 10 +++ gcc/fortran/trans-intrinsic.c | 32 +++++--- gcc/testsuite/ChangeLog | 8 ++ gcc/testsuite/gfortran.dg/minmaxloc_1.f90 | 118 ++++++++++++++++++++++++++++++ gcc/testsuite/gfortran.dg/minmaxloc_2.f90 | 29 ++++++++ 5 files changed, 186 insertions(+), 11 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/minmaxloc_1.f90 create mode 100644 gcc/testsuite/gfortran.dg/minmaxloc_2.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index d0cbd0a..e3876fc 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,13 @@ +2007-06-24 Paul Thomas + + 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 PR fortran/31473 diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index d1c3710..874b108 100644 --- 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 5fbc133..17bddb1 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2007-06-24 Paul Thomas + + 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 * 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 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 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 +! +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 -- 2.7.4