diff options
| -rw-r--r-- | gcc/fortran/ChangeLog | 10 | ||||
| -rw-r--r-- | gcc/fortran/trans-intrinsic.c | 32 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 8 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/minmaxloc_1.f90 | 118 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/minmaxloc_2.f90 | 29 |
5 files changed, 186 insertions, 11 deletions
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 <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 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 <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 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 <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 |