Skip to content

R
riscv-gcc-1
Commit f0b3c58d by Paul Thomas
Options

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
parent dbb23396
Showing with 186 additions and 11 deletions
gcc/fortran/ChangeLog
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
......
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
......
gcc/testsuite/ChangeLog
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.
gcc/testsuite/gfortran.dg/minmaxloc_1.f90 0 → 100644
! { 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
gcc/testsuite/gfortran.dg/minmaxloc_2.f90 0 → 100644
! { 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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment