diff options
| -rw-r--r-- | gcc/fortran/trans-intrinsic.cc | 37 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/maxval_arg_eval_count.f90 | 88 |
2 files changed, 121 insertions, 4 deletions
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc index afbec5b..51237d0 100644 --- a/gcc/fortran/trans-intrinsic.cc +++ b/gcc/fortran/trans-intrinsic.cc @@ -6409,8 +6409,16 @@ gfc_conv_intrinsic_findloc (gfc_se *se, gfc_expr *expr) nonempty = false; S = from; while (S <= to) { - if (mask[S]) { nonempty = true; if (a[S] <= limit) goto lab; } - S++; + if (mask[S]) { + nonempty = true; + if (a[S] <= limit) { + limit = a[S]; + S++; + goto lab; + } + else + S++; + } } limit = nonempty ? NaN : huge (limit); lab: @@ -6419,7 +6427,15 @@ gfc_conv_intrinsic_findloc (gfc_se *se, gfc_expr *expr) at runtime whether array is nonempty or not, rank 1: limit = Infinity; S = from; - while (S <= to) { if (a[S] <= limit) goto lab; S++; } + while (S <= to) { + if (a[S] <= limit) { + limit = a[S]; + S++; + goto lab; + } + else + S++; + } limit = (from <= to) ? NaN : huge (limit); lab: while (S <= to) { limit = min (a[S], limit); S++; } @@ -6710,6 +6726,7 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op) gfc_copy_loopinfo_to_se (&arrayse, &loop); arrayse.ss = arrayss; gfc_conv_expr_val (&arrayse, arrayexpr); + arrayse.expr = gfc_evaluate_now (arrayse.expr, &arrayse.pre); gfc_add_block_to_block (&block, &arrayse.pre); gfc_init_block (&block2); @@ -6722,7 +6739,18 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op) tmp = fold_build2_loc (input_location, op == GT_EXPR ? GE_EXPR : LE_EXPR, logical_type_node, arrayse.expr, limit); if (lab) - ifbody = build1_v (GOTO_EXPR, lab); + { + stmtblock_t ifblock; + tree inc_loop; + inc_loop = fold_build2_loc (input_location, PLUS_EXPR, + TREE_TYPE (loop.loopvar[0]), + loop.loopvar[0], gfc_index_one_node); + gfc_init_block (&ifblock); + gfc_add_modify (&ifblock, limit, arrayse.expr); + gfc_add_modify (&ifblock, loop.loopvar[0], inc_loop); + gfc_add_expr_to_block (&ifblock, build1_v (GOTO_EXPR, lab)); + ifbody = gfc_finish_block (&ifblock); + } else { stmtblock_t ifblock; @@ -6816,6 +6844,7 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op) gfc_copy_loopinfo_to_se (&arrayse, &loop); arrayse.ss = arrayss; gfc_conv_expr_val (&arrayse, arrayexpr); + arrayse.expr = gfc_evaluate_now (arrayse.expr, &arrayse.pre); gfc_add_block_to_block (&block, &arrayse.pre); /* MIN_EXPR/MAX_EXPR has unspecified behavior with NaNs or diff --git a/gcc/testsuite/gfortran.dg/maxval_arg_eval_count.f90 b/gcc/testsuite/gfortran.dg/maxval_arg_eval_count.f90 new file mode 100644 index 0000000..1c1a048 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/maxval_arg_eval_count.f90 @@ -0,0 +1,88 @@ +! { dg-do run } +! +! PR fortran/118613 - check argument evaluation count of MAXVAL + +program p + implicit none + integer, parameter :: k = 2 + integer :: n + integer :: i1(k*k), i2(k,k), mm + real :: a1(k*k), a2(k,k), mx + complex :: c1(k*k), c2(k,k) + logical :: m1(k*k), m2(k,k) + + ! prepare mask for masked variants + m1 = .true. + m2 = .true. + i1 = 0 + i2 = 0 + a1 = 0. + a2 = 0. + c1 = 0. + c2 = 0. + + ! integer + n = 0 + mm = maxval (h(i1)) + if (n /= k*k .or. mm /= 0) stop 1 + n = 0 + mm = maxval (h(i2)) + if (n /= k*k .or. mm /= 0) stop 2 + n = 0 + mm = maxval (h(i1),m1) + if (n /= k*k .or. mm /= 0) stop 3 + n = 0 + mm = maxval (h(i2),m2) + if (n /= k*k .or. mm /= 0) stop 4 + + ! real + n = 0 + mx = maxval (f(a1)) + if (n /= k*k .or. mx /= 0) stop 5 + n = 0 + mx = maxval (f(a2)) + if (n /= k*k .or. mx /= 0) stop 6 + n = 0 + mx = maxval (f(a1),m1) + if (n /= k*k .or. mx /= 0) stop 7 + n = 0 + mx = maxval (f(a2),m2) + if (n /= k*k .or. mx /= 0) stop 8 + + ! complex + n = 0 + mx = maxval (g(c1)) + if (n /= k*k .or. mx /= 0) stop 9 + n = 0 + mx = maxval (g(c2)) + if (n /= k*k .or. mx /= 0) stop 10 + n = 0 + mx = maxval (g(c1),m1) + if (n /= k*k .or. mx /= 0) stop 11 + n = 0 + mx = maxval (g(c2),m2) + if (n /= k*k .or. mx /= 0) stop 12 + +contains + + impure elemental function h (x) + integer, intent(in) :: x + integer :: h + h = abs (x) + n = n + 1 ! Count number of function evaluations + end + + impure elemental function f (x) + real, intent(in) :: x + real :: f + f = abs (x) + n = n + 1 ! Count number of function evaluations + end + + impure elemental function g (x) + complex, intent(in) :: x + real :: g + g = abs (x) + n = n + 1 ! Count number of function evaluations + end +end |