This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[PATCH] Fix up NaN and +-Inf handling and speed up inline m{in,ax}{loc,val} intrinsics (PR fortran/40643, PR fortran/31067, take 2)
- From: Jakub Jelinek <jakub at redhat dot com>
- To: gcc-patches at gcc dot gnu dot org
- Cc: fortran at gcc dot gnu dot org
- Date: Thu, 16 Jul 2009 15:12:42 +0200
- Subject: [PATCH] Fix up NaN and +-Inf handling and speed up inline m{in,ax}{loc,val} intrinsics (PR fortran/40643, PR fortran/31067, take 2)
- References: <20090715161316.GL4462@tyan-ft48-01.lab.bos.redhat.com>
- Reply-to: Jakub Jelinek <jakub at redhat dot com>
On Wed, Jul 15, 2009 at 06:13:16PM +0200, Jakub Jelinek wrote:
> Currently bootstrapping on x86_64-linux and i686-linux, ok for trunk
> if it passes?
The patch I've posted yesterday broke for minval/maxval without dim= on
rank > 1 arrays, I didn't expect inline minval/maxval to handle them (given
that minloc/maxloc only handles rank == 1 arrays inline).
The following patch fixes that and slightly improves even the two loops
minloc/maxloc case, if we didn't terminate the first loop prematurely, we
surely don't need to try to execute the second loop, on the other side if we
executed the second loop, we know pos != 0, so can avoid the conditional
after it.
I've also added another test with rank > 1 arrays and also array sections.
Bootstrapped/regtested on x86_64-linux and i686-linux, ok for trunk?
2009-07-16 Jakub Jelinek <jakub@redhat.com>
PR fortran/40643
PR fortran/31067
* trans-intrinsic.c (gfc_conv_intrinsic_minmaxloc,
gfc_conv_intrinsic_minmaxval): Handle Infinities and NaNs properly,
optimize.
* trans-array.c (gfc_trans_scalarized_loop_end): No longer static.
* trans-array.h (gfc_trans_scalarized_loop_end): New prototype.
* gfortran.dg/minlocval_1.f90: New test.
* gfortran.dg/minlocval_2.f90: New test.
* gfortran.dg/minlocval_3.f90: New test.
* gfortran.dg/maxlocval_2.f90: New test.
* gfortran.dg/maxlocval_3.f90: New test.
--- gcc/fortran/trans-intrinsic.c.jj 2009-07-10 15:09:12.000000000 +0200
+++ gcc/fortran/trans-intrinsic.c 2009-07-16 11:28:00.000000000 +0200
@@ -2133,6 +2133,74 @@ gfc_conv_intrinsic_dot_product (gfc_se *
}
+/* Emit code for minloc or maxloc intrinsic. There are many different cases
+ we need to handle. For performance reasons we sometimes create two
+ loops instead of one, where the second one is much simpler.
+ Examples for minloc intrinsic:
+ 1) Result is an array, a call is generated
+ 2) Array mask is used and NaNs need to be supported:
+ limit = Infinity;
+ pos2 = 0;
+ pos = 0;
+ S = from;
+ while (S <= to) {
+ if (mask[S]) {
+ if (pos2 == 0) pos2 = S + (1 - from);
+ if (a[S] <= limit) { limit = a[S]; pos = S + (1 - from); goto lab1; }
+ }
+ S++;
+ }
+ pos = pos2;
+ goto lab2;
+ lab1:;
+ while (S <= to) {
+ if (mask[S]) if (a[S] < limit) { limit = a[S]; pos = S + (1 - from); }
+ S++;
+ }
+ lab2:;
+ 3) NaNs need to be supported, but it is known at compile time or cheaply
+ at runtime whether array is nonempty or not:
+ limit = Infinity;
+ pos = 0;
+ S = from;
+ while (S <= to) {
+ if (a[S] <= limit) { limit = a[S]; pos = S + (1 - from); goto lab1; }
+ S++;
+ }
+ if (from <= to) pos = 1;
+ goto lab2;
+ lab1:;
+ while (S <= to) {
+ if (a[S] < limit) { limit = a[S]; pos = S + (1 - from); }
+ S++;
+ }
+ lab2:;
+ 4) NaNs aren't supported, array mask is used:
+ limit = infinities_supported ? Infinity : huge (limit);
+ pos = 0;
+ S = from;
+ while (S <= to) {
+ if (mask[S]) { limit = a[S]; pos = S + (1 - from); goto lab1; }
+ S++;
+ }
+ goto lab2;
+ lab1:;
+ while (S <= to) {
+ if (mask[S]) if (a[S] < limit) { limit = a[S]; pos = S + (1 - from); }
+ S++;
+ }
+ lab2:;
+ 5) Same without array mask:
+ limit = infinities_supported ? Infinity : huge (limit);
+ pos = (from <= to) ? 1 : 0;
+ S = from;
+ while (S <= to) {
+ if (a[S] < limit) { limit = a[S]; pos = S + (1 - from); }
+ S++;
+ }
+ For 3) and 5), if mask is scalar, this all goes into a conditional,
+ setting pos = 0; in the else branch. */
+
static void
gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
{
@@ -2143,9 +2211,13 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * s
tree limit;
tree type;
tree tmp;
+ tree cond;
tree elsetmp;
tree ifbody;
tree offset;
+ tree nonempty;
+ tree pos2;
+ tree lab1, lab2;
gfc_loopinfo loop;
gfc_actual_arglist *actual;
gfc_ss *arrayss;
@@ -2177,21 +2249,39 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * s
actual = actual->next->next;
gcc_assert (actual);
maskexpr = actual->expr;
+ nonempty = NULL;
if (maskexpr && maskexpr->rank != 0)
{
maskss = gfc_walk_expr (maskexpr);
gcc_assert (maskss != gfc_ss_terminator);
}
else
- maskss = NULL;
+ {
+ mpz_t asize;
+ if (gfc_array_size (arrayexpr, &asize) == SUCCESS)
+ {
+ nonempty = gfc_conv_mpz_to_tree (asize, gfc_index_integer_kind);
+ mpz_clear (asize);
+ nonempty = fold_build2 (GT_EXPR, boolean_type_node, nonempty,
+ gfc_index_zero_node);
+ }
+ maskss = NULL;
+ }
limit = gfc_create_var (gfc_typenode_for_spec (&arrayexpr->ts), "limit");
n = gfc_validate_kind (arrayexpr->ts.type, arrayexpr->ts.kind, false);
switch (arrayexpr->ts.type)
{
case BT_REAL:
- tmp = gfc_conv_mpfr_to_tree (gfc_real_kinds[n].huge,
- arrayexpr->ts.kind, 0);
+ if (HONOR_INFINITIES (DECL_MODE (limit)))
+ {
+ REAL_VALUE_TYPE real;
+ real_inf (&real);
+ tmp = build_real (TREE_TYPE (limit), real);
+ }
+ else
+ tmp = gfc_conv_mpfr_to_tree (gfc_real_kinds[n].huge,
+ arrayexpr->ts.kind, 0);
break;
case BT_INTEGER:
@@ -2226,11 +2316,37 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * s
gfc_conv_loop_setup (&loop, &expr->where);
gcc_assert (loop.dimen == 1);
+ if (nonempty == NULL && maskss == NULL && loop.from[0] && loop.to[0])
+ nonempty = fold_build2 (LE_EXPR, boolean_type_node, loop.from[0],
+ loop.to[0]);
+ lab1 = NULL;
+ lab2 = NULL;
/* Initialize the position to zero, following Fortran 2003. We are free
to do this because Fortran 95 allows the result of an entirely false
- mask to be processor dependent. */
- gfc_add_modify (&loop.pre, pos, gfc_index_zero_node);
+ mask to be processor dependent. If we know at compile time the array
+ is non-empty and no MASK is used, we can initialize to 1 to simplify
+ the inner loop. */
+ if (nonempty != NULL && !HONOR_NANS (DECL_MODE (limit)))
+ gfc_add_modify (&loop.pre, pos,
+ fold_build3 (COND_EXPR, gfc_array_index_type,
+ nonempty, gfc_index_one_node,
+ gfc_index_zero_node));
+ else
+ {
+ gfc_add_modify (&loop.pre, pos, gfc_index_zero_node);
+ lab1 = gfc_build_label_decl (NULL_TREE);
+ TREE_USED (lab1) = 1;
+ lab2 = gfc_build_label_decl (NULL_TREE);
+ TREE_USED (lab2) = 1;
+ }
+ if (nonempty == NULL && HONOR_NANS (DECL_MODE (limit)))
+ {
+ pos2 = gfc_create_var (gfc_array_index_type, "pos2");
+ gfc_add_modify (&se->pre, pos2, gfc_index_zero_node);
+ }
+ else
+ pos2 = NULL;
gfc_mark_ss_chain_used (arrayss, 1);
if (maskss)
@@ -2272,27 +2388,47 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * s
gfc_index_one_node, loop.from[0]);
else
tmp = gfc_index_one_node;
-
+
gfc_add_modify (&block, offset, tmp);
+ if (pos2)
+ {
+ stmtblock_t ifblock2;
+ tree ifbody2;
+
+ gfc_start_block (&ifblock2);
+ tmp = fold_build2 (PLUS_EXPR, TREE_TYPE (pos),
+ loop.loopvar[0], offset);
+ gfc_add_modify (&ifblock2, pos2, tmp);
+ ifbody2 = gfc_finish_block (&ifblock2);
+ cond = fold_build2 (EQ_EXPR, boolean_type_node, pos2,
+ gfc_index_zero_node);
+ tmp = build3_v (COND_EXPR, cond, ifbody2,
+ build_empty_stmt (input_location));
+ gfc_add_expr_to_block (&block, tmp);
+ }
+
tmp = fold_build2 (PLUS_EXPR, TREE_TYPE (pos),
loop.loopvar[0], offset);
gfc_add_modify (&ifblock, pos, tmp);
+ if (lab1)
+ gfc_add_expr_to_block (&ifblock, build1_v (GOTO_EXPR, lab1));
+
ifbody = gfc_finish_block (&ifblock);
- /* If it is a more extreme value or pos is still zero and the value
- equal to the limit. */
- tmp = fold_build2 (TRUTH_AND_EXPR, boolean_type_node,
- fold_build2 (EQ_EXPR, boolean_type_node,
- pos, gfc_index_zero_node),
- fold_build2 (EQ_EXPR, boolean_type_node,
- arrayse.expr, limit));
- tmp = fold_build2 (TRUTH_OR_EXPR, boolean_type_node,
- fold_build2 (op, boolean_type_node,
- arrayse.expr, limit), tmp);
- tmp = build3_v (COND_EXPR, tmp, ifbody, build_empty_stmt (input_location));
- gfc_add_expr_to_block (&block, tmp);
+ if (!lab1 || HONOR_NANS (DECL_MODE (limit)))
+ {
+ if (lab1)
+ cond = fold_build2 (op == GT_EXPR ? GE_EXPR : LE_EXPR,
+ boolean_type_node, arrayse.expr, limit);
+ else
+ cond = fold_build2 (op, boolean_type_node, arrayse.expr, limit);
+
+ ifbody = build3_v (COND_EXPR, cond, ifbody,
+ build_empty_stmt (input_location));
+ }
+ gfc_add_expr_to_block (&block, ifbody);
if (maskss)
{
@@ -2306,8 +2442,97 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * s
tmp = gfc_finish_block (&block);
gfc_add_expr_to_block (&body, tmp);
+ if (lab1)
+ {
+ gfc_trans_scalarized_loop_end (&loop, 0, &body);
+
+ if (HONOR_NANS (DECL_MODE (limit)))
+ {
+ if (pos2)
+ gfc_add_modify (&loop.code[0], pos, pos2);
+ else
+ {
+ ifbody = build2_v (MODIFY_EXPR, pos, gfc_index_one_node);
+ tmp = build3_v (COND_EXPR, nonempty, ifbody,
+ build_empty_stmt (input_location));
+ gfc_add_expr_to_block (&loop.code[0], tmp);
+ }
+ }
+
+ gfc_add_expr_to_block (&loop.code[0], build1_v (GOTO_EXPR, lab2));
+ gfc_add_expr_to_block (&loop.code[0], build1_v (LABEL_EXPR, lab1));
+ gfc_start_block (&body);
+
+ /* If we have a mask, only check this element if the mask is set. */
+ if (maskss)
+ {
+ gfc_init_se (&maskse, NULL);
+ gfc_copy_loopinfo_to_se (&maskse, &loop);
+ maskse.ss = maskss;
+ gfc_conv_expr_val (&maskse, maskexpr);
+ gfc_add_block_to_block (&body, &maskse.pre);
+
+ gfc_start_block (&block);
+ }
+ else
+ gfc_init_block (&block);
+
+ /* Compare with the current limit. */
+ gfc_init_se (&arrayse, NULL);
+ gfc_copy_loopinfo_to_se (&arrayse, &loop);
+ arrayse.ss = arrayss;
+ gfc_conv_expr_val (&arrayse, arrayexpr);
+ gfc_add_block_to_block (&block, &arrayse.pre);
+
+ /* We do the following if this is a more extreme value. */
+ gfc_start_block (&ifblock);
+
+ /* Assign the value to the limit... */
+ gfc_add_modify (&ifblock, limit, arrayse.expr);
+
+ /* Remember where we are. An offset must be added to the loop
+ counter to obtain the required position. */
+ if (loop.from[0])
+ tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type,
+ gfc_index_one_node, loop.from[0]);
+ else
+ tmp = gfc_index_one_node;
+
+ gfc_add_modify (&block, offset, tmp);
+
+ tmp = fold_build2 (PLUS_EXPR, TREE_TYPE (pos),
+ loop.loopvar[0], offset);
+ gfc_add_modify (&ifblock, pos, tmp);
+
+ ifbody = gfc_finish_block (&ifblock);
+
+ cond = fold_build2 (op, boolean_type_node, arrayse.expr, limit);
+
+ tmp = build3_v (COND_EXPR, cond, ifbody,
+ build_empty_stmt (input_location));
+ gfc_add_expr_to_block (&block, tmp);
+
+ if (maskss)
+ {
+ /* We enclose the above in if (mask) {...}. */
+ tmp = gfc_finish_block (&block);
+
+ tmp = build3_v (COND_EXPR, maskse.expr, tmp,
+ build_empty_stmt (input_location));
+ }
+ else
+ tmp = gfc_finish_block (&block);
+ gfc_add_expr_to_block (&body, tmp);
+ /* Avoid initializing loopvar[0] again, it should be left where
+ it finished by the first loop. */
+ loop.from[0] = loop.loopvar[0];
+ }
+
gfc_trans_scalarizing_loops (&loop, &body);
+ if (lab2)
+ gfc_add_expr_to_block (&loop.pre, build1_v (LABEL_EXPR, lab2));
+
/* For a scalar mask, enclose the loop in an if statement. */
if (maskexpr && maskss == NULL)
{
@@ -2339,6 +2564,99 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * s
se->expr = convert (type, pos);
}
+/* Emit code for minval or maxval intrinsic. There are many different cases
+ we need to handle. For performance reasons we sometimes create two
+ loops instead of one, where the second one is much simpler.
+ Examples for minval intrinsic:
+ 1) Result is an array, a call is generated
+ 2) Array mask is used and NaNs need to be supported, rank 1:
+ limit = Infinity;
+ nonempty = false;
+ S = from;
+ while (S <= to) {
+ if (mask[S]) { nonempty = true; if (a[S] <= limit) goto lab; }
+ S++;
+ }
+ limit = nonempty ? NaN : huge (limit);
+ lab:
+ while (S <= to) { if(mask[S]) limit = min (a[S], limit); S++; }
+ 3) NaNs need to be supported, but it is known at compile time or cheaply
+ at runtime whether array is nonempty or not, rank 1:
+ limit = Infinity;
+ S = from;
+ while (S <= to) { if (a[S] <= limit) goto lab; S++; }
+ limit = (from <= to) ? NaN : huge (limit);
+ lab:
+ while (S <= to) { limit = min (a[S], limit); S++; }
+ 4) Array mask is used and NaNs need to be supported, rank > 1:
+ limit = Infinity;
+ nonempty = false;
+ fast = false;
+ S1 = from1;
+ while (S1 <= to1) {
+ S2 = from2;
+ while (S2 <= to2) {
+ if (mask[S1][S2]) {
+ if (fast) limit = min (a[S1][S2], limit);
+ else {
+ nonempty = true;
+ if (a[S1][S2] <= limit) {
+ limit = a[S1][S2];
+ fast = true;
+ }
+ }
+ }
+ S2++;
+ }
+ S1++;
+ }
+ if (!fast)
+ limit = nonempty ? NaN : huge (limit);
+ 5) NaNs need to be supported, but it is known at compile time or cheaply
+ at runtime whether array is nonempty or not, rank > 1:
+ limit = Infinity;
+ fast = false;
+ S1 = from1;
+ while (S1 <= to1) {
+ S2 = from2;
+ while (S2 <= to2) {
+ if (fast) limit = min (a[S1][S2], limit);
+ else {
+ if (a[S1][S2] <= limit) {
+ limit = a[S1][S2];
+ fast = true;
+ }
+ }
+ S2++;
+ }
+ S1++;
+ }
+ if (!fast)
+ limit = (nonempty_array) ? NaN : huge (limit);
+ 6) NaNs aren't supported, but infinities are. Array mask is used:
+ limit = Infinity;
+ nonempty = false;
+ S = from;
+ while (S <= to) {
+ if (mask[S]) { nonempty = true; limit = min (a[S], limit); }
+ S++;
+ }
+ limit = nonempty ? limit : huge (limit);
+ 7) Same without array mask:
+ limit = Infinity;
+ S = from;
+ while (S <= to) { limit = min (a[S], limit); S++; }
+ limit = (from <= to) ? limit : huge (limit);
+ 8) Neither NaNs nor infinities are supported (-ffast-math or BT_INTEGER):
+ limit = huge (limit);
+ S = from;
+ while (S <= to) { limit = min (a[S], limit); S++); }
+ (or
+ while (S <= to) { if (mask[S]) limit = min (a[S], limit); S++; }
+ with array mask instead).
+ For 3), 5), 7) and 8), if mask is scalar, this all goes into a conditional,
+ setting limit = huge (limit); in the else branch. */
+
static void
gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op)
{
@@ -2346,8 +2664,13 @@ gfc_conv_intrinsic_minmaxval (gfc_se * s
tree type;
tree tmp;
tree ifbody;
+ tree nonempty;
+ tree nonempty_var;
+ tree lab;
+ tree fast;
+ tree huge_cst = NULL, nan_cst = NULL;
stmtblock_t body;
- stmtblock_t block;
+ stmtblock_t block, block2;
gfc_loopinfo loop;
gfc_actual_arglist *actual;
gfc_ss *arrayss;
@@ -2371,7 +2694,22 @@ gfc_conv_intrinsic_minmaxval (gfc_se * s
switch (expr->ts.type)
{
case BT_REAL:
- tmp = gfc_conv_mpfr_to_tree (gfc_real_kinds[n].huge, expr->ts.kind, 0);
+ huge_cst = gfc_conv_mpfr_to_tree (gfc_real_kinds[n].huge,
+ expr->ts.kind, 0);
+ if (HONOR_INFINITIES (DECL_MODE (limit)))
+ {
+ REAL_VALUE_TYPE real;
+ real_inf (&real);
+ tmp = build_real (type, real);
+ }
+ else
+ tmp = huge_cst;
+ if (HONOR_NANS (DECL_MODE (limit)))
+ {
+ REAL_VALUE_TYPE real;
+ real_nan (&real, "", 1, DECL_MODE (limit));
+ nan_cst = build_real (type, real);
+ }
break;
case BT_INTEGER:
@@ -2387,7 +2725,11 @@ gfc_conv_intrinsic_minmaxval (gfc_se * s
-HUGE for BT_REAL and (-HUGE - 1) for BT_INTEGER; the most positive
possible value is HUGE in both cases. */
if (op == GT_EXPR)
- tmp = fold_build1 (NEGATE_EXPR, TREE_TYPE (tmp), tmp);
+ {
+ tmp = fold_build1 (NEGATE_EXPR, TREE_TYPE (tmp), tmp);
+ if (huge_cst)
+ huge_cst = fold_build1 (NEGATE_EXPR, TREE_TYPE (huge_cst), huge_cst);
+ }
if (op == GT_EXPR && expr->ts.type == BT_INTEGER)
tmp = fold_build2 (MINUS_EXPR, TREE_TYPE (tmp),
@@ -2404,13 +2746,24 @@ gfc_conv_intrinsic_minmaxval (gfc_se * s
actual = actual->next->next;
gcc_assert (actual);
maskexpr = actual->expr;
+ nonempty = NULL;
if (maskexpr && maskexpr->rank != 0)
{
maskss = gfc_walk_expr (maskexpr);
gcc_assert (maskss != gfc_ss_terminator);
}
else
- maskss = NULL;
+ {
+ mpz_t asize;
+ if (gfc_array_size (arrayexpr, &asize) == SUCCESS)
+ {
+ nonempty = gfc_conv_mpz_to_tree (asize, gfc_index_integer_kind);
+ mpz_clear (asize);
+ nonempty = fold_build2 (GT_EXPR, boolean_type_node, nonempty,
+ gfc_index_zero_node);
+ }
+ maskss = NULL;
+ }
/* Initialize the scalarizer. */
gfc_init_loopinfo (&loop);
@@ -2422,6 +2775,35 @@ gfc_conv_intrinsic_minmaxval (gfc_se * s
gfc_conv_ss_startstride (&loop);
gfc_conv_loop_setup (&loop, &expr->where);
+ if (nonempty == NULL && maskss == NULL
+ && loop.dimen == 1 && loop.from[0] && loop.to[0])
+ nonempty = fold_build2 (LE_EXPR, boolean_type_node, loop.from[0],
+ loop.to[0]);
+ nonempty_var = NULL;
+ if (nonempty == NULL
+ && (HONOR_INFINITIES (DECL_MODE (limit))
+ || HONOR_NANS (DECL_MODE (limit))))
+ {
+ nonempty_var = gfc_create_var (boolean_type_node, "nonempty");
+ gfc_add_modify (&se->pre, nonempty_var, boolean_false_node);
+ nonempty = nonempty_var;
+ }
+ lab = NULL;
+ fast = NULL;
+ if (HONOR_NANS (DECL_MODE (limit)))
+ {
+ if (loop.dimen == 1)
+ {
+ lab = gfc_build_label_decl (NULL_TREE);
+ TREE_USED (lab) = 1;
+ }
+ else
+ {
+ fast = gfc_create_var (boolean_type_node, "fast");
+ gfc_add_modify (&se->pre, fast, boolean_false_node);
+ }
+ }
+
gfc_mark_ss_chain_used (arrayss, 1);
if (maskss)
gfc_mark_ss_chain_used (maskss, 1);
@@ -2449,13 +2831,50 @@ gfc_conv_intrinsic_minmaxval (gfc_se * s
gfc_conv_expr_val (&arrayse, arrayexpr);
gfc_add_block_to_block (&block, &arrayse.pre);
- /* Assign the value to the limit... */
- ifbody = build2_v (MODIFY_EXPR, limit, arrayse.expr);
+ gfc_init_block (&block2);
+
+ if (nonempty_var)
+ gfc_add_modify (&block2, nonempty_var, boolean_true_node);
+
+ if (HONOR_NANS (DECL_MODE (limit)))
+ {
+ tmp = fold_build2 (op == GT_EXPR ? GE_EXPR : LE_EXPR,
+ boolean_type_node, arrayse.expr, limit);
+ if (lab)
+ ifbody = build1_v (GOTO_EXPR, lab);
+ else
+ {
+ stmtblock_t ifblock;
+
+ gfc_init_block (&ifblock);
+ gfc_add_modify (&ifblock, limit, arrayse.expr);
+ gfc_add_modify (&ifblock, fast, boolean_true_node);
+ ifbody = gfc_finish_block (&ifblock);
+ }
+ tmp = build3_v (COND_EXPR, tmp, ifbody,
+ build_empty_stmt (input_location));
+ gfc_add_expr_to_block (&block2, tmp);
+ }
+ else
+ {
+ tmp = fold_build2 (op == GT_EXPR ? MAX_EXPR : MIN_EXPR,
+ type, arrayse.expr, limit);
+ gfc_add_modify (&block2, limit, tmp);
+ }
+
+ if (fast)
+ {
+ tree elsebody = gfc_finish_block (&block2);
+
+ tmp = fold_build2 (op == GT_EXPR ? MAX_EXPR : MIN_EXPR,
+ type, arrayse.expr, limit);
+ ifbody = build2_v (MODIFY_EXPR, limit, tmp);
+ tmp = build3_v (COND_EXPR, fast, ifbody, elsebody);
+ gfc_add_expr_to_block (&block, tmp);
+ }
+ else
+ gfc_add_block_to_block (&block, &block2);
- /* If it is a more extreme value. */
- tmp = fold_build2 (op, boolean_type_node, arrayse.expr, limit);
- tmp = build3_v (COND_EXPR, tmp, ifbody, build_empty_stmt (input_location));
- gfc_add_expr_to_block (&block, tmp);
gfc_add_block_to_block (&block, &arrayse.post);
tmp = gfc_finish_block (&block);
@@ -2465,11 +2884,74 @@ gfc_conv_intrinsic_minmaxval (gfc_se * s
build_empty_stmt (input_location));
gfc_add_expr_to_block (&body, tmp);
+ if (lab)
+ {
+ gfc_trans_scalarized_loop_end (&loop, 0, &body);
+
+ tmp = fold_build3 (COND_EXPR, type, nonempty, nan_cst, huge_cst);
+ gfc_add_modify (&loop.code[0], limit, tmp);
+ gfc_add_expr_to_block (&loop.code[0], build1_v (LABEL_EXPR, lab));
+
+ gfc_start_block (&body);
+
+ /* If we have a mask, only add this element if the mask is set. */
+ if (maskss)
+ {
+ gfc_init_se (&maskse, NULL);
+ gfc_copy_loopinfo_to_se (&maskse, &loop);
+ maskse.ss = maskss;
+ gfc_conv_expr_val (&maskse, maskexpr);
+ gfc_add_block_to_block (&body, &maskse.pre);
+
+ gfc_start_block (&block);
+ }
+ else
+ gfc_init_block (&block);
+
+ /* Compare with the current limit. */
+ gfc_init_se (&arrayse, NULL);
+ gfc_copy_loopinfo_to_se (&arrayse, &loop);
+ arrayse.ss = arrayss;
+ gfc_conv_expr_val (&arrayse, arrayexpr);
+ gfc_add_block_to_block (&block, &arrayse.pre);
+
+ tmp = fold_build2 (op == GT_EXPR ? MAX_EXPR : MIN_EXPR,
+ type, arrayse.expr, limit);
+ gfc_add_modify (&block, limit, tmp);
+
+ gfc_add_block_to_block (&block, &arrayse.post);
+
+ tmp = gfc_finish_block (&block);
+ if (maskss)
+ /* We enclose the above in if (mask) {...}. */
+ tmp = build3_v (COND_EXPR, maskse.expr, tmp,
+ build_empty_stmt (input_location));
+ gfc_add_expr_to_block (&body, tmp);
+ /* Avoid initializing loopvar[0] again, it should be left where
+ it finished by the first loop. */
+ loop.from[0] = loop.loopvar[0];
+ }
gfc_trans_scalarizing_loops (&loop, &body);
+ if (fast)
+ {
+ tmp = fold_build3 (COND_EXPR, type, nonempty, nan_cst, huge_cst);
+ ifbody = build2_v (MODIFY_EXPR, limit, tmp);
+ tmp = build3_v (COND_EXPR, fast, build_empty_stmt (input_location),
+ ifbody);
+ gfc_add_expr_to_block (&loop.pre, tmp);
+ }
+ else if (HONOR_INFINITIES (DECL_MODE (limit)) && !lab)
+ {
+ tmp = fold_build3 (COND_EXPR, type, nonempty, limit, huge_cst);
+ gfc_add_modify (&loop.pre, limit, tmp);
+ }
+
/* For a scalar mask, enclose the loop in an if statement. */
if (maskexpr && maskss == NULL)
{
+ tree else_stmt;
+
gfc_init_se (&maskse, NULL);
gfc_conv_expr_val (&maskse, maskexpr);
gfc_init_block (&block);
@@ -2477,8 +2959,11 @@ gfc_conv_intrinsic_minmaxval (gfc_se * s
gfc_add_block_to_block (&block, &loop.post);
tmp = gfc_finish_block (&block);
- tmp = build3_v (COND_EXPR, maskse.expr, tmp,
- build_empty_stmt (input_location));
+ if (HONOR_INFINITIES (DECL_MODE (limit)))
+ else_stmt = build2_v (MODIFY_EXPR, limit, huge_cst);
+ else
+ else_stmt = build_empty_stmt (input_location);
+ tmp = build3_v (COND_EXPR, maskse.expr, tmp, else_stmt);
gfc_add_expr_to_block (&block, tmp);
gfc_add_block_to_block (&se->pre, &block);
}
--- gcc/fortran/trans-array.c.jj 2009-07-03 11:14:44.000000000 +0200
+++ gcc/fortran/trans-array.c 2009-07-16 09:40:58.000000000 +0200
@@ -2748,7 +2748,7 @@ gfc_start_scalarized_body (gfc_loopinfo
/* Generates the actual loop code for a scalarization loop. */
-static void
+void
gfc_trans_scalarized_loop_end (gfc_loopinfo * loop, int n,
stmtblock_t * pbody)
{
@@ -2815,7 +2815,8 @@ gfc_trans_scalarized_loop_end (gfc_loopi
loopbody = gfc_finish_block (pbody);
/* Initialize the loopvar. */
- gfc_add_modify (&loop->code[n], loop->loopvar[n], loop->from[n]);
+ if (loop->loopvar[n] != loop->from[n])
+ gfc_add_modify (&loop->code[n], loop->loopvar[n], loop->from[n]);
exit_label = gfc_build_label_decl (NULL_TREE);
--- gcc/fortran/trans-array.h.jj 2009-06-11 13:24:14.000000000 +0200
+++ gcc/fortran/trans-array.h 2009-07-14 13:27:34.000000000 +0200
@@ -1,5 +1,5 @@
/* Header for array handling functions
- Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008
+ Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
Free Software Foundation, Inc.
Contributed by Paul Brook
@@ -84,6 +84,8 @@ void gfc_copy_loopinfo_to_se (gfc_se *,
/* Marks the start of a scalarized expression, and declares loop variables. */
void gfc_start_scalarized_body (gfc_loopinfo *, stmtblock_t *);
+/* Generates one actual loop for a scalarized expression. */
+void gfc_trans_scalarized_loop_end (gfc_loopinfo *, int, stmtblock_t *);
/* Generates the actual loops for a scalarized expression. */
void gfc_trans_scalarizing_loops (gfc_loopinfo *, stmtblock_t *);
/* Mark the end of the main loop body and the start of the copying loop. */
--- gcc/testsuite/gfortran.dg/maxlocval_2.f90.jj 2009-07-10 18:08:34.000000000 +0200
+++ gcc/testsuite/gfortran.dg/maxlocval_2.f90 2009-07-15 14:35:05.000000000 +0200
@@ -0,0 +1,153 @@
+! { dg-do run }
+ real :: a(3), nan, minf, pinf
+ real, allocatable :: c(:)
+ logical :: l
+ logical :: l2(3)
+
+ nan = 0.0
+ minf = 0.0
+ pinf = 0.0
+ nan = 0.0/nan
+ minf = -1.0/minf
+ pinf = 1.0/pinf
+
+ allocate (c(3))
+ a(:) = nan
+ if (maxloc (a, dim = 1).ne.1) call abort
+ if (.not.isnan(maxval (a, dim = 1))) call abort
+ a(:) = minf
+ if (maxloc (a, dim = 1).ne.1) call abort
+ if (maxval (a, dim = 1).ne.minf) call abort
+ a(1:2) = nan
+ if (maxloc (a, dim = 1).ne.3) call abort
+ if (maxval (a, dim = 1).ne.minf) call abort
+ a(2) = 1.0
+ if (maxloc (a, dim = 1).ne.2) call abort
+ if (maxval (a, dim = 1).ne.1) call abort
+ a(2) = pinf
+ if (maxloc (a, dim = 1).ne.2) call abort
+ if (maxval (a, dim = 1).ne.pinf) call abort
+ c(:) = nan
+ if (maxloc (c, dim = 1).ne.1) call abort
+ if (.not.isnan(maxval (c, dim = 1))) call abort
+ c(:) = minf
+ if (maxloc (c, dim = 1).ne.1) call abort
+ if (maxval (c, dim = 1).ne.minf) call abort
+ c(1:2) = nan
+ if (maxloc (c, dim = 1).ne.3) call abort
+ if (maxval (c, dim = 1).ne.minf) call abort
+ c(2) = 1.0
+ if (maxloc (c, dim = 1).ne.2) call abort
+ if (maxval (c, dim = 1).ne.1) call abort
+ c(2) = pinf
+ if (maxloc (c, dim = 1).ne.2) call abort
+ if (maxval (c, dim = 1).ne.pinf) call abort
+ l = .false.
+ l2(:) = .false.
+ a(:) = nan
+ if (maxloc (a, dim = 1, mask = l).ne.0) call abort
+ if (maxval (a, dim = 1, mask = l).ne.-huge(minf)) call abort
+ if (maxloc (a, dim = 1, mask = l2).ne.0) call abort
+ if (maxval (a, dim = 1, mask = l2).ne.-huge(minf)) call abort
+ a(:) = minf
+ if (maxloc (a, dim = 1, mask = l).ne.0) call abort
+ if (maxval (a, dim = 1, mask = l).ne.-huge(minf)) call abort
+ if (maxloc (a, dim = 1, mask = l2).ne.0) call abort
+ if (maxval (a, dim = 1, mask = l2).ne.-huge(minf)) call abort
+ a(1:2) = nan
+ if (maxloc (a, dim = 1, mask = l).ne.0) call abort
+ if (maxval (a, dim = 1, mask = l).ne.-huge(minf)) call abort
+ if (maxloc (a, dim = 1, mask = l2).ne.0) call abort
+ if (maxval (a, dim = 1, mask = l2).ne.-huge(minf)) call abort
+ a(2) = 1.0
+ if (maxloc (a, dim = 1, mask = l).ne.0) call abort
+ if (maxval (a, dim = 1, mask = l).ne.-huge(minf)) call abort
+ if (maxloc (a, dim = 1, mask = l2).ne.0) call abort
+ if (maxval (a, dim = 1, mask = l2).ne.-huge(minf)) call abort
+ a(2) = pinf
+ if (maxloc (a, dim = 1, mask = l).ne.0) call abort
+ if (maxval (a, dim = 1, mask = l).ne.-huge(minf)) call abort
+ if (maxloc (a, dim = 1, mask = l2).ne.0) call abort
+ if (maxval (a, dim = 1, mask = l2).ne.-huge(minf)) call abort
+ c(:) = nan
+ if (maxloc (c, dim = 1, mask = l).ne.0) call abort
+ if (maxval (c, dim = 1, mask = l).ne.-huge(minf)) call abort
+ if (maxloc (c, dim = 1, mask = l2).ne.0) call abort
+ if (maxval (c, dim = 1, mask = l2).ne.-huge(minf)) call abort
+ c(:) = minf
+ if (maxloc (c, dim = 1, mask = l).ne.0) call abort
+ if (maxval (c, dim = 1, mask = l).ne.-huge(minf)) call abort
+ if (maxloc (c, dim = 1, mask = l2).ne.0) call abort
+ if (maxval (c, dim = 1, mask = l2).ne.-huge(minf)) call abort
+ c(1:2) = nan
+ if (maxloc (c, dim = 1, mask = l).ne.0) call abort
+ if (maxval (c, dim = 1, mask = l).ne.-huge(minf)) call abort
+ if (maxloc (c, dim = 1, mask = l2).ne.0) call abort
+ if (maxval (c, dim = 1, mask = l2).ne.-huge(minf)) call abort
+ c(2) = 1.0
+ if (maxloc (c, dim = 1, mask = l).ne.0) call abort
+ if (maxval (c, dim = 1, mask = l).ne.-huge(minf)) call abort
+ if (maxloc (c, dim = 1, mask = l2).ne.0) call abort
+ if (maxval (c, dim = 1, mask = l2).ne.-huge(minf)) call abort
+ c(2) = pinf
+ if (maxloc (c, dim = 1, mask = l).ne.0) call abort
+ if (maxval (c, dim = 1, mask = l).ne.-huge(minf)) call abort
+ if (maxloc (c, dim = 1, mask = l2).ne.0) call abort
+ if (maxval (c, dim = 1, mask = l2).ne.-huge(minf)) call abort
+ l = .true.
+ l2(:) = .true.
+ a(:) = nan
+ if (maxloc (a, dim = 1, mask = l).ne.1) call abort
+ if (.not.isnan(maxval (a, dim = 1, mask = l))) call abort
+ if (maxloc (a, dim = 1, mask = l2).ne.1) call abort
+ if (.not.isnan(maxval (a, dim = 1, mask = l2))) call abort
+ a(:) = minf
+ if (maxloc (a, dim = 1, mask = l).ne.1) call abort
+ if (maxval (a, dim = 1, mask = l).ne.minf) call abort
+ if (maxloc (a, dim = 1, mask = l2).ne.1) call abort
+ if (maxval (a, dim = 1, mask = l2).ne.minf) call abort
+ a(1:2) = nan
+ if (maxloc (a, dim = 1, mask = l).ne.3) call abort
+ if (maxval (a, dim = 1, mask = l).ne.minf) call abort
+ if (maxloc (a, dim = 1, mask = l2).ne.3) call abort
+ if (maxval (a, dim = 1, mask = l2).ne.minf) call abort
+ a(2) = 1.0
+ if (maxloc (a, dim = 1, mask = l).ne.2) call abort
+ if (maxval (a, dim = 1, mask = l).ne.1) call abort
+ if (maxloc (a, dim = 1, mask = l2).ne.2) call abort
+ if (maxval (a, dim = 1, mask = l2).ne.1) call abort
+ a(2) = pinf
+ if (maxloc (a, dim = 1, mask = l).ne.2) call abort
+ if (maxval (a, dim = 1, mask = l).ne.pinf) call abort
+ if (maxloc (a, dim = 1, mask = l2).ne.2) call abort
+ if (maxval (a, dim = 1, mask = l2).ne.pinf) call abort
+ c(:) = nan
+ if (maxloc (c, dim = 1, mask = l).ne.1) call abort
+ if (.not.isnan(maxval (c, dim = 1, mask = l))) call abort
+ if (maxloc (c, dim = 1, mask = l2).ne.1) call abort
+ if (.not.isnan(maxval (c, dim = 1, mask = l2))) call abort
+ c(:) = minf
+ if (maxloc (c, dim = 1, mask = l).ne.1) call abort
+ if (maxval (c, dim = 1, mask = l).ne.minf) call abort
+ if (maxloc (c, dim = 1, mask = l2).ne.1) call abort
+ if (maxval (c, dim = 1, mask = l2).ne.minf) call abort
+ c(1:2) = nan
+ if (maxloc (c, dim = 1, mask = l).ne.3) call abort
+ if (maxval (c, dim = 1, mask = l).ne.minf) call abort
+ if (maxloc (c, dim = 1, mask = l2).ne.3) call abort
+ if (maxval (c, dim = 1, mask = l2).ne.minf) call abort
+ c(2) = 1.0
+ if (maxloc (c, dim = 1, mask = l).ne.2) call abort
+ if (maxval (c, dim = 1, mask = l).ne.1) call abort
+ if (maxloc (c, dim = 1, mask = l2).ne.2) call abort
+ if (maxval (c, dim = 1, mask = l2).ne.1) call abort
+ c(2) = pinf
+ if (maxloc (c, dim = 1, mask = l).ne.2) call abort
+ if (maxval (c, dim = 1, mask = l).ne.pinf) call abort
+ if (maxloc (c, dim = 1, mask = l2).ne.2) call abort
+ if (maxval (c, dim = 1, mask = l2).ne.pinf) call abort
+ deallocate (c)
+ allocate (c(-2:-3))
+ if (maxloc (c, dim = 1).ne.0) call abort
+ if (maxval (c, dim = 1).ne.-huge(minf)) call abort
+end
--- gcc/testsuite/gfortran.dg/minlocval_2.f90.jj 2009-07-15 16:19:10.000000000 +0200
+++ gcc/testsuite/gfortran.dg/minlocval_2.f90 2009-07-15 16:18:36.000000000 +0200
@@ -0,0 +1,122 @@
+! { dg-do run }
+ integer :: a(3), h
+ integer, allocatable :: c(:)
+ logical :: l
+ logical :: l2(3)
+
+ h = -huge(h)
+ h = h - 1
+ allocate (c(3))
+ a(:) = 5
+ if (minloc (a, dim = 1).ne.1) call abort
+ if (minval (a, dim = 1).ne.5) call abort
+ a(2) = h
+ if (minloc (a, dim = 1).ne.2) call abort
+ if (minval (a, dim = 1).ne.h) call abort
+ a(:) = huge(h)
+ if (minloc (a, dim = 1).ne.1) call abort
+ if (minval (a, dim = 1).ne.huge(h)) call abort
+ a(3) = huge(h) - 1
+ if (minloc (a, dim = 1).ne.3) call abort
+ if (minval (a, dim = 1).ne.huge(h)-1) call abort
+ c(:) = 5
+ if (minloc (c, dim = 1).ne.1) call abort
+ if (minval (c, dim = 1).ne.5) call abort
+ c(2) = h
+ if (minloc (c, dim = 1).ne.2) call abort
+ if (minval (c, dim = 1).ne.h) call abort
+ c(:) = huge(h)
+ if (minloc (c, dim = 1).ne.1) call abort
+ if (minval (c, dim = 1).ne.huge(h)) call abort
+ c(3) = huge(h) - 1
+ if (minloc (c, dim = 1).ne.3) call abort
+ if (minval (c, dim = 1).ne.huge(h)-1) call abort
+ l = .false.
+ l2(:) = .false.
+ a(:) = 5
+ if (minloc (a, dim = 1, mask = l).ne.0) call abort
+ if (minval (a, dim = 1, mask = l).ne.huge(h)) call abort
+ if (minloc (a, dim = 1, mask = l2).ne.0) call abort
+ if (minval (a, dim = 1, mask = l2).ne.huge(h)) call abort
+ a(2) = h
+ if (minloc (a, dim = 1, mask = l).ne.0) call abort
+ if (minval (a, dim = 1, mask = l).ne.huge(h)) call abort
+ if (minloc (a, dim = 1, mask = l2).ne.0) call abort
+ if (minval (a, dim = 1, mask = l2).ne.huge(h)) call abort
+ a(:) = huge(h)
+ if (minloc (a, dim = 1, mask = l).ne.0) call abort
+ if (minval (a, dim = 1, mask = l).ne.huge(h)) call abort
+ if (minloc (a, dim = 1, mask = l2).ne.0) call abort
+ if (minval (a, dim = 1, mask = l2).ne.huge(h)) call abort
+ a(3) = huge(h) - 1
+ if (minloc (a, dim = 1, mask = l).ne.0) call abort
+ if (minval (a, dim = 1, mask = l).ne.huge(h)) call abort
+ if (minloc (a, dim = 1, mask = l2).ne.0) call abort
+ if (minval (a, dim = 1, mask = l2).ne.huge(h)) call abort
+ c(:) = 5
+ if (minloc (c, dim = 1, mask = l).ne.0) call abort
+ if (minval (c, dim = 1, mask = l).ne.huge(h)) call abort
+ if (minloc (c, dim = 1, mask = l2).ne.0) call abort
+ if (minval (c, dim = 1, mask = l2).ne.huge(h)) call abort
+ c(2) = h
+ if (minloc (c, dim = 1, mask = l).ne.0) call abort
+ if (minval (c, dim = 1, mask = l).ne.huge(h)) call abort
+ if (minloc (c, dim = 1, mask = l2).ne.0) call abort
+ if (minval (c, dim = 1, mask = l2).ne.huge(h)) call abort
+ c(:) = huge(h)
+ if (minloc (c, dim = 1, mask = l).ne.0) call abort
+ if (minval (c, dim = 1, mask = l).ne.huge(h)) call abort
+ if (minloc (c, dim = 1, mask = l2).ne.0) call abort
+ if (minval (c, dim = 1, mask = l2).ne.huge(h)) call abort
+ c(3) = huge(h) - 1
+ if (minloc (c, dim = 1, mask = l).ne.0) call abort
+ if (minval (c, dim = 1, mask = l).ne.huge(h)) call abort
+ if (minloc (c, dim = 1, mask = l2).ne.0) call abort
+ if (minval (c, dim = 1, mask = l2).ne.huge(h)) call abort
+ l = .true.
+ l2(:) = .true.
+ a(:) = 5
+ if (minloc (a, dim = 1, mask = l).ne.1) call abort
+ if (minval (a, dim = 1, mask = l).ne.5) call abort
+ if (minloc (a, dim = 1, mask = l2).ne.1) call abort
+ if (minval (a, dim = 1, mask = l2).ne.5) call abort
+ a(2) = h
+ if (minloc (a, dim = 1, mask = l).ne.2) call abort
+ if (minval (a, dim = 1, mask = l).ne.h) call abort
+ if (minloc (a, dim = 1, mask = l2).ne.2) call abort
+ if (minval (a, dim = 1, mask = l2).ne.h) call abort
+ a(:) = huge(h)
+ if (minloc (a, dim = 1, mask = l).ne.1) call abort
+ if (minval (a, dim = 1, mask = l).ne.huge(h)) call abort
+ if (minloc (a, dim = 1, mask = l2).ne.1) call abort
+ if (minval (a, dim = 1, mask = l2).ne.huge(h)) call abort
+ a(3) = huge(h) - 1
+ if (minloc (a, dim = 1, mask = l).ne.3) call abort
+ if (minval (a, dim = 1, mask = l).ne.huge(h)-1) call abort
+ if (minloc (a, dim = 1, mask = l2).ne.3) call abort
+ if (minval (a, dim = 1, mask = l2).ne.huge(h)-1) call abort
+ c(:) = 5
+ if (minloc (c, dim = 1, mask = l).ne.1) call abort
+ if (minval (c, dim = 1, mask = l).ne.5) call abort
+ if (minloc (c, dim = 1, mask = l2).ne.1) call abort
+ if (minval (c, dim = 1, mask = l2).ne.5) call abort
+ c(2) = h
+ if (minloc (c, dim = 1, mask = l).ne.2) call abort
+ if (minval (c, dim = 1, mask = l).ne.h) call abort
+ if (minloc (c, dim = 1, mask = l2).ne.2) call abort
+ if (minval (c, dim = 1, mask = l2).ne.h) call abort
+ c(:) = huge(h)
+ if (minloc (c, dim = 1, mask = l).ne.1) call abort
+ if (minval (c, dim = 1, mask = l).ne.huge(h)) call abort
+ if (minloc (c, dim = 1, mask = l2).ne.1) call abort
+ if (minval (c, dim = 1, mask = l2).ne.huge(h)) call abort
+ c(3) = huge(h) - 1
+ if (minloc (c, dim = 1, mask = l).ne.3) call abort
+ if (minval (c, dim = 1, mask = l).ne.huge(h)-1) call abort
+ if (minloc (c, dim = 1, mask = l2).ne.3) call abort
+ if (minval (c, dim = 1, mask = l2).ne.huge(h)-1) call abort
+ deallocate (c)
+ allocate (c(-2:-3))
+ if (minloc (c, dim = 1).ne.0) call abort
+ if (minval (c, dim = 1).ne.huge(h)) call abort
+end
--- gcc/testsuite/gfortran.dg/minlocval_3.f90.jj 2009-07-16 12:05:25.000000000 +0200
+++ gcc/testsuite/gfortran.dg/minlocval_3.f90 2009-07-16 12:56:29.000000000 +0200
@@ -0,0 +1,284 @@
+ real :: a(30), b(10, 10), m
+ real, allocatable :: c(:), d(:, :)
+ integer :: e(30), f(10, 10), n
+ integer, allocatable :: g(:), h(:,:)
+ logical :: l(30), l2(10, 10)
+ allocate (c (30))
+ allocate (d (10, 10))
+ allocate (g (30))
+ allocate (h (10, 10))
+ a = 7.0
+ b = 7.0
+ c = 7.0
+ d = 7.0
+ e = 7
+ f = 7
+ g = 7
+ h = 7
+ m = huge(m)
+ n = huge(n)
+ a(7) = 6.0
+ b(5, 5) = 6.0
+ b(5, 6) = 5.0
+ b(6, 7) = 4.0
+ c(7) = 6.0
+ d(5, 5) = 6.0
+ d(5, 6) = 5.0
+ d(6, 7) = 4.0
+ e(7) = 6
+ f(5, 5) = 6
+ f(5, 6) = 5
+ f(6, 7) = 4
+ g(7) = 6
+ h(5, 5) = 6
+ h(5, 6) = 5
+ h(6, 7) = 4
+ if (minloc (a, dim = 1).ne.7) call abort
+ if (minval (a, dim = 1).ne.6.0) call abort
+ if (minloc (a(::2), dim = 1).ne.4) call abort
+ if (minval (a(::2), dim = 1).ne.6.0) call abort
+ if (any (minloc (a).ne.(/ 7 /))) call abort
+ if (minval (a).ne.6.0) call abort
+ if (any (minloc (a(::2)).ne.(/ 4 /))) call abort
+ if (minval (a(::2)).ne.6.0) call abort
+ if (any (minloc (b, dim = 1).ne.(/ 1, 1, 1, 1, 5, 5, 6, 1, 1, 1 /))) call abort
+ if (any (minval (b, dim = 1).ne.(/ 7.0, 7.0, 7.0, 7.0, 6.0, 5.0, 4.0, 7.0, 7.0, 7.0 /))) call abort
+ if (any (minloc (b(::2,::2), dim = 1).ne.(/ 1, 1, 3, 1, 1 /))) call abort
+ if (any (minval (b(::2,::2), dim = 1).ne.(/ 7.0, 7.0, 6.0, 7.0, 7.0 /))) call abort
+ if (any (minloc (b, dim = 2).ne.(/ 1, 1, 1, 1, 6, 7, 1, 1, 1, 1 /))) call abort
+ if (any (minval (b, dim = 2).ne.(/ 7.0, 7.0, 7.0, 7.0, 5.0, 4.0, 7.0, 7.0, 7.0, 7.0 /))) call abort
+ if (any (minloc (b(::2,::2), dim = 2).ne.(/ 1, 1, 3, 1, 1 /))) call abort
+ if (any (minval (b(::2,::2), dim = 2).ne.(/ 7.0, 7.0, 6.0, 7.0, 7.0 /))) call abort
+ if (any (minloc (b).ne.(/ 6, 7 /))) call abort
+ if (minval (b).ne.4.0) call abort
+ if (any (minloc (b(::2,::2)).ne.(/ 3, 3 /))) call abort
+ if (minval (b(::2,::2)).ne.6.0) call abort
+ if (minloc (c, dim = 1).ne.7) call abort
+ if (minval (c, dim = 1).ne.6.0) call abort
+ if (minloc (c(::2), dim = 1).ne.4) call abort
+ if (minval (c(::2), dim = 1).ne.6.0) call abort
+ if (any (minloc (c).ne.(/ 7 /))) call abort
+ if (minval (c).ne.6.0) call abort
+ if (any (minloc (c(::2)).ne.(/ 4 /))) call abort
+ if (minval (c(::2)).ne.6.0) call abort
+ if (any (minloc (d, dim = 1).ne.(/ 1, 1, 1, 1, 5, 5, 6, 1, 1, 1 /))) call abort
+ if (any (minval (d, dim = 1).ne.(/ 7.0, 7.0, 7.0, 7.0, 6.0, 5.0, 4.0, 7.0, 7.0, 7.0 /))) call abort
+ if (any (minloc (d(::2,::2), dim = 1).ne.(/ 1, 1, 3, 1, 1 /))) call abort
+ if (any (minval (d(::2,::2), dim = 1).ne.(/ 7.0, 7.0, 6.0, 7.0, 7.0 /))) call abort
+ if (any (minloc (d, dim = 2).ne.(/ 1, 1, 1, 1, 6, 7, 1, 1, 1, 1 /))) call abort
+ if (any (minval (d, dim = 2).ne.(/ 7.0, 7.0, 7.0, 7.0, 5.0, 4.0, 7.0, 7.0, 7.0, 7.0 /))) call abort
+ if (any (minloc (d(::2,::2), dim = 2).ne.(/ 1, 1, 3, 1, 1 /))) call abort
+ if (any (minval (d(::2,::2), dim = 2).ne.(/ 7.0, 7.0, 6.0, 7.0, 7.0 /))) call abort
+ if (any (minloc (d).ne.(/ 6, 7 /))) call abort
+ if (minval (d).ne.4.0) call abort
+ if (any (minloc (d(::2,::2)).ne.(/ 3, 3 /))) call abort
+ if (minval (d(::2,::2)).ne.6.0) call abort
+ if (minloc (e, dim = 1).ne.7) call abort
+ if (minval (e, dim = 1).ne.6) call abort
+ if (minloc (e(::2), dim = 1).ne.4) call abort
+ if (minval (e(::2), dim = 1).ne.6) call abort
+ if (any (minloc (e).ne.(/ 7 /))) call abort
+ if (minval (e).ne.6) call abort
+ if (any (minloc (e(::2)).ne.(/ 4 /))) call abort
+ if (minval (e(::2)).ne.6) call abort
+ if (any (minloc (f, dim = 1).ne.(/ 1, 1, 1, 1, 5, 5, 6, 1, 1, 1 /))) call abort
+ if (any (minval (f, dim = 1).ne.(/ 7, 7, 7, 7, 6, 5, 4, 7, 7, 7 /))) call abort
+ if (any (minloc (f(::2,::2), dim = 1).ne.(/ 1, 1, 3, 1, 1 /))) call abort
+ if (any (minval (f(::2,::2), dim = 1).ne.(/ 7, 7, 6, 7, 7 /))) call abort
+ if (any (minloc (f, dim = 2).ne.(/ 1, 1, 1, 1, 6, 7, 1, 1, 1, 1 /))) call abort
+ if (any (minval (f, dim = 2).ne.(/ 7, 7, 7, 7, 5, 4, 7, 7, 7, 7 /))) call abort
+ if (any (minloc (f(::2,::2), dim = 2).ne.(/ 1, 1, 3, 1, 1 /))) call abort
+ if (any (minval (f(::2,::2), dim = 2).ne.(/ 7, 7, 6, 7, 7 /))) call abort
+ if (any (minloc (f).ne.(/ 6, 7 /))) call abort
+ if (minval (f).ne.4) call abort
+ if (any (minloc (f(::2,::2)).ne.(/ 3, 3 /))) call abort
+ if (minval (f(::2,::2)).ne.6) call abort
+ if (minloc (g, dim = 1).ne.7) call abort
+ if (minval (g, dim = 1).ne.6) call abort
+ if (minloc (g(::2), dim = 1).ne.4) call abort
+ if (minval (g(::2), dim = 1).ne.6) call abort
+ if (any (minloc (g).ne.(/ 7 /))) call abort
+ if (minval (g).ne.6) call abort
+ if (any (minloc (g(::2)).ne.(/ 4 /))) call abort
+ if (minval (g(::2)).ne.6) call abort
+ if (any (minloc (h, dim = 1).ne.(/ 1, 1, 1, 1, 5, 5, 6, 1, 1, 1 /))) call abort
+ if (any (minval (h, dim = 1).ne.(/ 7, 7, 7, 7, 6, 5, 4, 7, 7, 7 /))) call abort
+ if (any (minloc (h(::2,::2), dim = 1).ne.(/ 1, 1, 3, 1, 1 /))) call abort
+ if (any (minval (h(::2,::2), dim = 1).ne.(/ 7, 7, 6, 7, 7 /))) call abort
+ if (any (minloc (h, dim = 2).ne.(/ 1, 1, 1, 1, 6, 7, 1, 1, 1, 1 /))) call abort
+ if (any (minval (h, dim = 2).ne.(/ 7, 7, 7, 7, 5, 4, 7, 7, 7, 7 /))) call abort
+ if (any (minloc (h(::2,::2), dim = 2).ne.(/ 1, 1, 3, 1, 1 /))) call abort
+ if (any (minval (h(::2,::2), dim = 2).ne.(/ 7, 7, 6, 7, 7 /))) call abort
+ if (any (minloc (h).ne.(/ 6, 7 /))) call abort
+ if (minval (h).ne.4) call abort
+ if (any (minloc (h(::2,::2)).ne.(/ 3, 3 /))) call abort
+ if (minval (h(::2,::2)).ne.6) call abort
+ l = .true.
+ l2 = .true.
+ if (minloc (a, dim = 1, mask = l).ne.7) call abort
+ if (minval (a, dim = 1, mask = l).ne.6.0) call abort
+ if (minloc (a(::2), dim = 1, mask = l(::2)).ne.4) call abort
+ if (minval (a(::2), dim = 1, mask = l(::2)).ne.6.0) call abort
+ if (any (minloc (a, mask = l).ne.(/ 7 /))) call abort
+ if (minval (a, mask = l).ne.6.0) call abort
+ if (any (minloc (a(::2), mask = l(::2)).ne.(/ 4 /))) call abort
+ if (minval (a(::2), mask = l(::2)).ne.6.0) call abort
+ if (any (minloc (b, dim = 1, mask = l2).ne.(/ 1, 1, 1, 1, 5, 5, 6, 1, 1, 1 /))) call abort
+ if (any (minval (b, dim = 1, mask = l2).ne.(/ 7.0, 7.0, 7.0, 7.0, 6.0, 5.0, 4.0, 7.0, 7.0, 7.0 /))) call abort
+ if (any (minloc (b(::2,::2), dim = 1, mask = l2(::2,::2)).ne.(/ 1, 1, 3, 1, 1 /))) call abort
+ if (any (minval (b(::2,::2), dim = 1, mask = l2(::2,::2)).ne.(/ 7.0, 7.0, 6.0, 7.0, 7.0 /))) call abort
+ if (any (minloc (b, dim = 2, mask = l2).ne.(/ 1, 1, 1, 1, 6, 7, 1, 1, 1, 1 /))) call abort
+ if (any (minval (b, dim = 2, mask = l2).ne.(/ 7.0, 7.0, 7.0, 7.0, 5.0, 4.0, 7.0, 7.0, 7.0, 7.0 /))) call abort
+ if (any (minloc (b(::2,::2), dim = 2, mask = l2(::2,::2)).ne.(/ 1, 1, 3, 1, 1 /))) call abort
+ if (any (minval (b(::2,::2), dim = 2, mask = l2(::2,::2)).ne.(/ 7.0, 7.0, 6.0, 7.0, 7.0 /))) call abort
+ if (any (minloc (b, mask = l2).ne.(/ 6, 7 /))) call abort
+ if (minval (b, mask = l2).ne.4.0) call abort
+ if (any (minloc (b(::2,::2), mask = l2(::2,::2)).ne.(/ 3, 3 /))) call abort
+ if (minval (b(::2,::2), mask = l2(::2,::2)).ne.6.0) call abort
+ if (minloc (c, dim = 1, mask = l).ne.7) call abort
+ if (minval (c, dim = 1, mask = l).ne.6.0) call abort
+ if (minloc (c(::2), dim = 1, mask = l(::2)).ne.4) call abort
+ if (minval (c(::2), dim = 1, mask = l(::2)).ne.6.0) call abort
+ if (any (minloc (c, mask = l).ne.(/ 7 /))) call abort
+ if (minval (c, mask = l).ne.6.0) call abort
+ if (any (minloc (c(::2), mask = l(::2)).ne.(/ 4 /))) call abort
+ if (minval (c(::2), mask = l(::2)).ne.6.0) call abort
+ if (any (minloc (d, dim = 1, mask = l2).ne.(/ 1, 1, 1, 1, 5, 5, 6, 1, 1, 1 /))) call abort
+ if (any (minval (d, dim = 1, mask = l2).ne.(/ 7.0, 7.0, 7.0, 7.0, 6.0, 5.0, 4.0, 7.0, 7.0, 7.0 /))) call abort
+ if (any (minloc (d(::2,::2), dim = 1, mask = l2(::2,::2)).ne.(/ 1, 1, 3, 1, 1 /))) call abort
+ if (any (minval (d(::2,::2), dim = 1, mask = l2(::2,::2)).ne.(/ 7.0, 7.0, 6.0, 7.0, 7.0 /))) call abort
+ if (any (minloc (d, dim = 2, mask = l2).ne.(/ 1, 1, 1, 1, 6, 7, 1, 1, 1, 1 /))) call abort
+ if (any (minval (d, dim = 2, mask = l2).ne.(/ 7.0, 7.0, 7.0, 7.0, 5.0, 4.0, 7.0, 7.0, 7.0, 7.0 /))) call abort
+ if (any (minloc (d(::2,::2), dim = 2, mask = l2(::2,::2)).ne.(/ 1, 1, 3, 1, 1 /))) call abort
+ if (any (minval (d(::2,::2), dim = 2, mask = l2(::2,::2)).ne.(/ 7.0, 7.0, 6.0, 7.0, 7.0 /))) call abort
+ if (any (minloc (d, mask = l2).ne.(/ 6, 7 /))) call abort
+ if (minval (d, mask = l2).ne.4.0) call abort
+ if (any (minloc (d(::2,::2), mask = l2(::2,::2)).ne.(/ 3, 3 /))) call abort
+ if (minval (d(::2,::2), mask = l2(::2,::2)).ne.6.0) call abort
+ if (minloc (e, dim = 1, mask = l).ne.7) call abort
+ if (minval (e, dim = 1, mask = l).ne.6) call abort
+ if (minloc (e(::2), dim = 1, mask = l(::2)).ne.4) call abort
+ if (minval (e(::2), dim = 1, mask = l(::2)).ne.6) call abort
+ if (any (minloc (e, mask = l).ne.(/ 7 /))) call abort
+ if (minval (e, mask = l).ne.6) call abort
+ if (any (minloc (e(::2), mask = l(::2)).ne.(/ 4 /))) call abort
+ if (minval (e(::2), mask = l(::2)).ne.6) call abort
+ if (any (minloc (f, dim = 1, mask = l2).ne.(/ 1, 1, 1, 1, 5, 5, 6, 1, 1, 1 /))) call abort
+ if (any (minval (f, dim = 1, mask = l2).ne.(/ 7, 7, 7, 7, 6, 5, 4, 7, 7, 7 /))) call abort
+ if (any (minloc (f(::2,::2), dim = 1, mask = l2(::2,::2)).ne.(/ 1, 1, 3, 1, 1 /))) call abort
+ if (any (minval (f(::2,::2), dim = 1, mask = l2(::2,::2)).ne.(/ 7, 7, 6, 7, 7 /))) call abort
+ if (any (minloc (f, dim = 2, mask = l2).ne.(/ 1, 1, 1, 1, 6, 7, 1, 1, 1, 1 /))) call abort
+ if (any (minval (f, dim = 2, mask = l2).ne.(/ 7, 7, 7, 7, 5, 4, 7, 7, 7, 7 /))) call abort
+ if (any (minloc (f(::2,::2), dim = 2, mask = l2(::2,::2)).ne.(/ 1, 1, 3, 1, 1 /))) call abort
+ if (any (minval (f(::2,::2), dim = 2, mask = l2(::2,::2)).ne.(/ 7, 7, 6, 7, 7 /))) call abort
+ if (any (minloc (f, mask = l2).ne.(/ 6, 7 /))) call abort
+ if (minval (f, mask = l2).ne.4) call abort
+ if (any (minloc (f(::2,::2), mask = l2(::2,::2)).ne.(/ 3, 3 /))) call abort
+ if (minval (f(::2,::2), mask = l2(::2,::2)).ne.6) call abort
+ if (minloc (g, dim = 1, mask = l).ne.7) call abort
+ if (minval (g, dim = 1, mask = l).ne.6) call abort
+ if (minloc (g(::2), dim = 1, mask = l(::2)).ne.4) call abort
+ if (minval (g(::2), dim = 1, mask = l(::2)).ne.6) call abort
+ if (any (minloc (g, mask = l).ne.(/ 7 /))) call abort
+ if (minval (g, mask = l).ne.6) call abort
+ if (any (minloc (g(::2), mask = l(::2)).ne.(/ 4 /))) call abort
+ if (minval (g(::2), mask = l(::2)).ne.6) call abort
+ if (any (minloc (h, dim = 1, mask = l2).ne.(/ 1, 1, 1, 1, 5, 5, 6, 1, 1, 1 /))) call abort
+ if (any (minval (h, dim = 1, mask = l2).ne.(/ 7, 7, 7, 7, 6, 5, 4, 7, 7, 7 /))) call abort
+ if (any (minloc (h(::2,::2), dim = 1, mask = l2(::2,::2)).ne.(/ 1, 1, 3, 1, 1 /))) call abort
+ if (any (minval (h(::2,::2), dim = 1, mask = l2(::2,::2)).ne.(/ 7, 7, 6, 7, 7 /))) call abort
+ if (any (minloc (h, dim = 2, mask = l2).ne.(/ 1, 1, 1, 1, 6, 7, 1, 1, 1, 1 /))) call abort
+ if (any (minval (h, dim = 2, mask = l2).ne.(/ 7, 7, 7, 7, 5, 4, 7, 7, 7, 7 /))) call abort
+ if (any (minloc (h(::2,::2), dim = 2, mask = l2(::2,::2)).ne.(/ 1, 1, 3, 1, 1 /))) call abort
+ if (any (minval (h(::2,::2), dim = 2, mask = l2(::2,::2)).ne.(/ 7, 7, 6, 7, 7 /))) call abort
+ if (any (minloc (h, mask = l2).ne.(/ 6, 7 /))) call abort
+ if (minval (h, mask = l2).ne.4) call abort
+ if (any (minloc (h(::2,::2), mask = l2(::2,::2)).ne.(/ 3, 3 /))) call abort
+ if (minval (h(::2,::2), mask = l2(::2,::2)).ne.6) call abort
+ l = .false.
+ l2 = .false.
+ if (minloc (a, dim = 1, mask = l).ne.0) call abort
+ if (minval (a, dim = 1, mask = l).ne.m) call abort
+ if (minloc (a(::2), dim = 1, mask = l(::2)).ne.0) call abort
+ if (minval (a(::2), dim = 1, mask = l(::2)).ne.m) call abort
+ if (any (minloc (a, mask = l).ne.(/ 0 /))) call abort
+ if (minval (a, mask = l).ne.m) call abort
+ if (any (minloc (a(::2), mask = l(::2)).ne.(/ 0 /))) call abort
+ if (minval (a(::2), mask = l(::2)).ne.m) call abort
+ if (any (minloc (b, dim = 1, mask = l2).ne.(/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /))) call abort
+ if (any (minval (b, dim = 1, mask = l2).ne.(/ m, m, m, m, m, m, m, m, m, m /))) call abort
+ if (any (minloc (b(::2,::2), dim = 1, mask = l2(::2,::2)).ne.(/ 0, 0, 0, 0, 0 /))) call abort
+ if (any (minval (b(::2,::2), dim = 1, mask = l2(::2,::2)).ne.(/ m, m, m, m, m /))) call abort
+ if (any (minloc (b, dim = 2, mask = l2).ne.(/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /))) call abort
+ if (any (minval (b, dim = 2, mask = l2).ne.(/ m, m, m, m, m, m, m, m, m, m /))) call abort
+ if (any (minloc (b(::2,::2), dim = 2, mask = l2(::2,::2)).ne.(/ 0, 0, 0, 0, 0 /))) call abort
+ if (any (minval (b(::2,::2), dim = 2, mask = l2(::2,::2)).ne.(/ m, m, m, m, m /))) call abort
+ if (any (minloc (b, mask = l2).ne.(/ 0, 0 /))) call abort
+ if (minval (b, mask = l2).ne.m) call abort
+ if (any (minloc (b(::2,::2), mask = l2(::2,::2)).ne.(/ 0, 0 /))) call abort
+ if (minval (b(::2,::2), mask = l2(::2,::2)).ne.m) call abort
+ if (minloc (c, dim = 1, mask = l).ne.0) call abort
+ if (minval (c, dim = 1, mask = l).ne.m) call abort
+ if (minloc (c(::2), dim = 1, mask = l(::2)).ne.0) call abort
+ if (minval (c(::2), dim = 1, mask = l(::2)).ne.m) call abort
+ if (any (minloc (c, mask = l).ne.(/ 0 /))) call abort
+ if (minval (c, mask = l).ne.m) call abort
+ if (any (minloc (c(::2), mask = l(::2)).ne.(/ 0 /))) call abort
+ if (minval (c(::2), mask = l(::2)).ne.m) call abort
+ if (any (minloc (d, dim = 1, mask = l2).ne.(/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /))) call abort
+ if (any (minval (d, dim = 1, mask = l2).ne.(/ m, m, m, m, m, m, m, m, m, m /))) call abort
+ if (any (minloc (d(::2,::2), dim = 1, mask = l2(::2,::2)).ne.(/ 0, 0, 0, 0, 0 /))) call abort
+ if (any (minval (d(::2,::2), dim = 1, mask = l2(::2,::2)).ne.(/ m, m, m, m, m /))) call abort
+ if (any (minloc (d, dim = 2, mask = l2).ne.(/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /))) call abort
+ if (any (minval (d, dim = 2, mask = l2).ne.(/ m, m, m, m, m, m, m, m, m, m /))) call abort
+ if (any (minloc (d(::2,::2), dim = 2, mask = l2(::2,::2)).ne.(/ 0, 0, 0, 0, 0 /))) call abort
+ if (any (minval (d(::2,::2), dim = 2, mask = l2(::2,::2)).ne.(/ m, m, m, m, m /))) call abort
+ if (any (minloc (d, mask = l2).ne.(/ 0, 0 /))) call abort
+ if (minval (d, mask = l2).ne.m) call abort
+ if (any (minloc (d(::2,::2), mask = l2(::2,::2)).ne.(/ 0, 0 /))) call abort
+ if (minval (d(::2,::2), mask = l2(::2,::2)).ne.m) call abort
+ if (minloc (e, dim = 1, mask = l).ne.0) call abort
+ if (minval (e, dim = 1, mask = l).ne.n) call abort
+ if (minloc (e(::2), dim = 1, mask = l(::2)).ne.0) call abort
+ if (minval (e(::2), dim = 1, mask = l(::2)).ne.n) call abort
+ if (any (minloc (e, mask = l).ne.(/ 0 /))) call abort
+ if (minval (e, mask = l).ne.n) call abort
+ if (any (minloc (e(::2), mask = l(::2)).ne.(/ 0 /))) call abort
+ if (minval (e(::2), mask = l(::2)).ne.n) call abort
+ if (any (minloc (f, dim = 1, mask = l2).ne.(/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /))) call abort
+ if (any (minval (f, dim = 1, mask = l2).ne.(/ n, n, n, n, n, n, n, n, n, n /))) call abort
+ if (any (minloc (f(::2,::2), dim = 1, mask = l2(::2,::2)).ne.(/ 0, 0, 0, 0, 0 /))) call abort
+ if (any (minval (f(::2,::2), dim = 1, mask = l2(::2,::2)).ne.(/ n, n, n, n, n /))) call abort
+ if (any (minloc (f, dim = 2, mask = l2).ne.(/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /))) call abort
+ if (any (minval (f, dim = 2, mask = l2).ne.(/ n, n, n, n, n, n, n, n, n, n /))) call abort
+ if (any (minloc (f(::2,::2), dim = 2, mask = l2(::2,::2)).ne.(/ 0, 0, 0, 0, 0 /))) call abort
+ if (any (minval (f(::2,::2), dim = 2, mask = l2(::2,::2)).ne.(/ n, n, n, n, n /))) call abort
+ if (any (minloc (f, mask = l2).ne.(/ 0, 0 /))) call abort
+ if (minval (f, mask = l2).ne.n) call abort
+ if (any (minloc (f(::2,::2), mask = l2(::2,::2)).ne.(/ 0, 0 /))) call abort
+ if (minval (f(::2,::2), mask = l2(::2,::2)).ne.n) call abort
+ if (minloc (g, dim = 1, mask = l).ne.0) call abort
+ if (minval (g, dim = 1, mask = l).ne.n) call abort
+ if (minloc (g(::2), dim = 1, mask = l(::2)).ne.0) call abort
+ if (minval (g(::2), dim = 1, mask = l(::2)).ne.n) call abort
+ if (any (minloc (g, mask = l).ne.(/ 0 /))) call abort
+ if (minval (g, mask = l).ne.n) call abort
+ if (any (minloc (g(::2), mask = l(::2)).ne.(/ 0 /))) call abort
+ if (minval (g(::2), mask = l(::2)).ne.n) call abort
+ if (any (minloc (h, dim = 1, mask = l2).ne.(/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /))) call abort
+ if (any (minval (h, dim = 1, mask = l2).ne.(/ n, n, n, n, n, n, n, n, n, n /))) call abort
+ if (any (minloc (h(::2,::2), dim = 1, mask = l2(::2,::2)).ne.(/ 0, 0, 0, 0, 0 /))) call abort
+ if (any (minval (h(::2,::2), dim = 1, mask = l2(::2,::2)).ne.(/ n, n, n, n, n /))) call abort
+ if (any (minloc (h, dim = 2, mask = l2).ne.(/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /))) call abort
+ if (any (minval (h, dim = 2, mask = l2).ne.(/ n, n, n, n, n, n, n, n, n, n /))) call abort
+ if (any (minloc (h(::2,::2), dim = 2, mask = l2(::2,::2)).ne.(/ 0, 0, 0, 0, 0 /))) call abort
+ if (any (minval (h(::2,::2), dim = 2, mask = l2(::2,::2)).ne.(/ n, n, n, n, n /))) call abort
+ if (any (minloc (h, mask = l2).ne.(/ 0, 0 /))) call abort
+ if (minval (h, mask = l2).ne.n) call abort
+ if (any (minloc (h(::2,::2), mask = l2(::2,::2)).ne.(/ 0, 0 /))) call abort
+ if (minval (h(::2,::2), mask = l2(::2,::2)).ne.n) call abort
+ a = 7.0
+ b = 7.0
+ c = 7.0
+ d = 7.0
+end
--- gcc/testsuite/gfortran.dg/maxlocval_3.f90.jj 2009-07-15 17:38:26.000000000 +0200
+++ gcc/testsuite/gfortran.dg/maxlocval_3.f90 2009-07-15 17:33:14.000000000 +0200
@@ -0,0 +1,122 @@
+! { dg-do run }
+ integer :: a(3), h
+ integer, allocatable :: c(:)
+ logical :: l
+ logical :: l2(3)
+
+ h = -huge(h)
+ h = h - 1
+ allocate (c(3))
+ a(:) = 5
+ if (maxloc (a, dim = 1).ne.1) call abort
+ if (maxval (a, dim = 1).ne.5) call abort
+ a(2) = huge(h)
+ if (maxloc (a, dim = 1).ne.2) call abort
+ if (maxval (a, dim = 1).ne.huge(h)) call abort
+ a(:) = h
+ if (maxloc (a, dim = 1).ne.1) call abort
+ if (maxval (a, dim = 1).ne.h) call abort
+ a(3) = -huge(h)
+ if (maxloc (a, dim = 1).ne.3) call abort
+ if (maxval (a, dim = 1).ne.-huge(h)) call abort
+ c(:) = 5
+ if (maxloc (c, dim = 1).ne.1) call abort
+ if (maxval (c, dim = 1).ne.5) call abort
+ c(2) = huge(h)
+ if (maxloc (c, dim = 1).ne.2) call abort
+ if (maxval (c, dim = 1).ne.huge(h)) call abort
+ c(:) = h
+ if (maxloc (c, dim = 1).ne.1) call abort
+ if (maxval (c, dim = 1).ne.h) call abort
+ c(3) = -huge(h)
+ if (maxloc (c, dim = 1).ne.3) call abort
+ if (maxval (c, dim = 1).ne.-huge(h)) call abort
+ l = .false.
+ l2(:) = .false.
+ a(:) = 5
+ if (maxloc (a, dim = 1, mask = l).ne.0) call abort
+ if (maxval (a, dim = 1, mask = l).ne.h) call abort
+ if (maxloc (a, dim = 1, mask = l2).ne.0) call abort
+ if (maxval (a, dim = 1, mask = l2).ne.h) call abort
+ a(2) = huge(h)
+ if (maxloc (a, dim = 1, mask = l).ne.0) call abort
+ if (maxval (a, dim = 1, mask = l).ne.h) call abort
+ if (maxloc (a, dim = 1, mask = l2).ne.0) call abort
+ if (maxval (a, dim = 1, mask = l2).ne.h) call abort
+ a(:) = h
+ if (maxloc (a, dim = 1, mask = l).ne.0) call abort
+ if (maxval (a, dim = 1, mask = l).ne.h) call abort
+ if (maxloc (a, dim = 1, mask = l2).ne.0) call abort
+ if (maxval (a, dim = 1, mask = l2).ne.h) call abort
+ a(3) = -huge(h)
+ if (maxloc (a, dim = 1, mask = l).ne.0) call abort
+ if (maxval (a, dim = 1, mask = l).ne.h) call abort
+ if (maxloc (a, dim = 1, mask = l2).ne.0) call abort
+ if (maxval (a, dim = 1, mask = l2).ne.h) call abort
+ c(:) = 5
+ if (maxloc (c, dim = 1, mask = l).ne.0) call abort
+ if (maxval (c, dim = 1, mask = l).ne.h) call abort
+ if (maxloc (c, dim = 1, mask = l2).ne.0) call abort
+ if (maxval (c, dim = 1, mask = l2).ne.h) call abort
+ c(2) = huge(h)
+ if (maxloc (c, dim = 1, mask = l).ne.0) call abort
+ if (maxval (c, dim = 1, mask = l).ne.h) call abort
+ if (maxloc (c, dim = 1, mask = l2).ne.0) call abort
+ if (maxval (c, dim = 1, mask = l2).ne.h) call abort
+ c(:) = h
+ if (maxloc (c, dim = 1, mask = l).ne.0) call abort
+ if (maxval (c, dim = 1, mask = l).ne.h) call abort
+ if (maxloc (c, dim = 1, mask = l2).ne.0) call abort
+ if (maxval (c, dim = 1, mask = l2).ne.h) call abort
+ c(3) = -huge(h)
+ if (maxloc (c, dim = 1, mask = l).ne.0) call abort
+ if (maxval (c, dim = 1, mask = l).ne.h) call abort
+ if (maxloc (c, dim = 1, mask = l2).ne.0) call abort
+ if (maxval (c, dim = 1, mask = l2).ne.h) call abort
+ l = .true.
+ l2(:) = .true.
+ a(:) = 5
+ if (maxloc (a, dim = 1, mask = l).ne.1) call abort
+ if (maxval (a, dim = 1, mask = l).ne.5) call abort
+ if (maxloc (a, dim = 1, mask = l2).ne.1) call abort
+ if (maxval (a, dim = 1, mask = l2).ne.5) call abort
+ a(2) = huge(h)
+ if (maxloc (a, dim = 1, mask = l).ne.2) call abort
+ if (maxval (a, dim = 1, mask = l).ne.huge(h)) call abort
+ if (maxloc (a, dim = 1, mask = l2).ne.2) call abort
+ if (maxval (a, dim = 1, mask = l2).ne.huge(h)) call abort
+ a(:) = h
+ if (maxloc (a, dim = 1, mask = l).ne.1) call abort
+ if (maxval (a, dim = 1, mask = l).ne.h) call abort
+ if (maxloc (a, dim = 1, mask = l2).ne.1) call abort
+ if (maxval (a, dim = 1, mask = l2).ne.h) call abort
+ a(3) = -huge(h)
+ if (maxloc (a, dim = 1, mask = l).ne.3) call abort
+ if (maxval (a, dim = 1, mask = l).ne.-huge(h)) call abort
+ if (maxloc (a, dim = 1, mask = l2).ne.3) call abort
+ if (maxval (a, dim = 1, mask = l2).ne.-huge(h)) call abort
+ c(:) = 5
+ if (maxloc (c, dim = 1, mask = l).ne.1) call abort
+ if (maxval (c, dim = 1, mask = l).ne.5) call abort
+ if (maxloc (c, dim = 1, mask = l2).ne.1) call abort
+ if (maxval (c, dim = 1, mask = l2).ne.5) call abort
+ c(2) = huge(h)
+ if (maxloc (c, dim = 1, mask = l).ne.2) call abort
+ if (maxval (c, dim = 1, mask = l).ne.huge(h)) call abort
+ if (maxloc (c, dim = 1, mask = l2).ne.2) call abort
+ if (maxval (c, dim = 1, mask = l2).ne.huge(h)) call abort
+ c(:) = h
+ if (maxloc (c, dim = 1, mask = l).ne.1) call abort
+ if (maxval (c, dim = 1, mask = l).ne.h) call abort
+ if (maxloc (c, dim = 1, mask = l2).ne.1) call abort
+ if (maxval (c, dim = 1, mask = l2).ne.h) call abort
+ c(3) = -huge(h)
+ if (maxloc (c, dim = 1, mask = l).ne.3) call abort
+ if (maxval (c, dim = 1, mask = l).ne.-huge(h)) call abort
+ if (maxloc (c, dim = 1, mask = l2).ne.3) call abort
+ if (maxval (c, dim = 1, mask = l2).ne.-huge(h)) call abort
+ deallocate (c)
+ allocate (c(-2:-3))
+ if (maxloc (c, dim = 1).ne.0) call abort
+ if (maxval (c, dim = 1).ne.h) call abort
+end
--- gcc/testsuite/gfortran.dg/minlocval_1.f90.jj 2009-07-15 14:37:36.000000000 +0200
+++ gcc/testsuite/gfortran.dg/minlocval_1.f90 2009-07-15 14:41:37.000000000 +0200
@@ -0,0 +1,153 @@
+! { dg-do run }
+ real :: a(3), nan, minf, pinf
+ real, allocatable :: c(:)
+ logical :: l
+ logical :: l2(3)
+
+ nan = 0.0
+ minf = 0.0
+ pinf = 0.0
+ nan = 0.0/nan
+ minf = -1.0/minf
+ pinf = 1.0/pinf
+
+ allocate (c(3))
+ a(:) = nan
+ if (minloc (a, dim = 1).ne.1) call abort
+ if (.not.isnan(minval (a, dim = 1))) call abort
+ a(:) = pinf
+ if (minloc (a, dim = 1).ne.1) call abort
+ if (minval (a, dim = 1).ne.pinf) call abort
+ a(1:2) = nan
+ if (minloc (a, dim = 1).ne.3) call abort
+ if (minval (a, dim = 1).ne.pinf) call abort
+ a(2) = 1.0
+ if (minloc (a, dim = 1).ne.2) call abort
+ if (minval (a, dim = 1).ne.1) call abort
+ a(2) = minf
+ if (minloc (a, dim = 1).ne.2) call abort
+ if (minval (a, dim = 1).ne.minf) call abort
+ c(:) = nan
+ if (minloc (c, dim = 1).ne.1) call abort
+ if (.not.isnan(minval (c, dim = 1))) call abort
+ c(:) = pinf
+ if (minloc (c, dim = 1).ne.1) call abort
+ if (minval (c, dim = 1).ne.pinf) call abort
+ c(1:2) = nan
+ if (minloc (c, dim = 1).ne.3) call abort
+ if (minval (c, dim = 1).ne.pinf) call abort
+ c(2) = 1.0
+ if (minloc (c, dim = 1).ne.2) call abort
+ if (minval (c, dim = 1).ne.1) call abort
+ c(2) = minf
+ if (minloc (c, dim = 1).ne.2) call abort
+ if (minval (c, dim = 1).ne.minf) call abort
+ l = .false.
+ l2(:) = .false.
+ a(:) = nan
+ if (minloc (a, dim = 1, mask = l).ne.0) call abort
+ if (minval (a, dim = 1, mask = l).ne.huge(pinf)) call abort
+ if (minloc (a, dim = 1, mask = l2).ne.0) call abort
+ if (minval (a, dim = 1, mask = l2).ne.huge(pinf)) call abort
+ a(:) = pinf
+ if (minloc (a, dim = 1, mask = l).ne.0) call abort
+ if (minval (a, dim = 1, mask = l).ne.huge(pinf)) call abort
+ if (minloc (a, dim = 1, mask = l2).ne.0) call abort
+ if (minval (a, dim = 1, mask = l2).ne.huge(pinf)) call abort
+ a(1:2) = nan
+ if (minloc (a, dim = 1, mask = l).ne.0) call abort
+ if (minval (a, dim = 1, mask = l).ne.huge(pinf)) call abort
+ if (minloc (a, dim = 1, mask = l2).ne.0) call abort
+ if (minval (a, dim = 1, mask = l2).ne.huge(pinf)) call abort
+ a(2) = 1.0
+ if (minloc (a, dim = 1, mask = l).ne.0) call abort
+ if (minval (a, dim = 1, mask = l).ne.huge(pinf)) call abort
+ if (minloc (a, dim = 1, mask = l2).ne.0) call abort
+ if (minval (a, dim = 1, mask = l2).ne.huge(pinf)) call abort
+ a(2) = minf
+ if (minloc (a, dim = 1, mask = l).ne.0) call abort
+ if (minval (a, dim = 1, mask = l).ne.huge(pinf)) call abort
+ if (minloc (a, dim = 1, mask = l2).ne.0) call abort
+ if (minval (a, dim = 1, mask = l2).ne.huge(pinf)) call abort
+ c(:) = nan
+ if (minloc (c, dim = 1, mask = l).ne.0) call abort
+ if (minval (c, dim = 1, mask = l).ne.huge(pinf)) call abort
+ if (minloc (c, dim = 1, mask = l2).ne.0) call abort
+ if (minval (c, dim = 1, mask = l2).ne.huge(pinf)) call abort
+ c(:) = pinf
+ if (minloc (c, dim = 1, mask = l).ne.0) call abort
+ if (minval (c, dim = 1, mask = l).ne.huge(pinf)) call abort
+ if (minloc (c, dim = 1, mask = l2).ne.0) call abort
+ if (minval (c, dim = 1, mask = l2).ne.huge(pinf)) call abort
+ c(1:2) = nan
+ if (minloc (c, dim = 1, mask = l).ne.0) call abort
+ if (minval (c, dim = 1, mask = l).ne.huge(pinf)) call abort
+ if (minloc (c, dim = 1, mask = l2).ne.0) call abort
+ if (minval (c, dim = 1, mask = l2).ne.huge(pinf)) call abort
+ c(2) = 1.0
+ if (minloc (c, dim = 1, mask = l).ne.0) call abort
+ if (minval (c, dim = 1, mask = l).ne.huge(pinf)) call abort
+ if (minloc (c, dim = 1, mask = l2).ne.0) call abort
+ if (minval (c, dim = 1, mask = l2).ne.huge(pinf)) call abort
+ c(2) = minf
+ if (minloc (c, dim = 1, mask = l).ne.0) call abort
+ if (minval (c, dim = 1, mask = l).ne.huge(pinf)) call abort
+ if (minloc (c, dim = 1, mask = l2).ne.0) call abort
+ if (minval (c, dim = 1, mask = l2).ne.huge(pinf)) call abort
+ l = .true.
+ l2(:) = .true.
+ a(:) = nan
+ if (minloc (a, dim = 1, mask = l).ne.1) call abort
+ if (.not.isnan(minval (a, dim = 1, mask = l))) call abort
+ if (minloc (a, dim = 1, mask = l2).ne.1) call abort
+ if (.not.isnan(minval (a, dim = 1, mask = l2))) call abort
+ a(:) = pinf
+ if (minloc (a, dim = 1, mask = l).ne.1) call abort
+ if (minval (a, dim = 1, mask = l).ne.pinf) call abort
+ if (minloc (a, dim = 1, mask = l2).ne.1) call abort
+ if (minval (a, dim = 1, mask = l2).ne.pinf) call abort
+ a(1:2) = nan
+ if (minloc (a, dim = 1, mask = l).ne.3) call abort
+ if (minval (a, dim = 1, mask = l).ne.pinf) call abort
+ if (minloc (a, dim = 1, mask = l2).ne.3) call abort
+ if (minval (a, dim = 1, mask = l2).ne.pinf) call abort
+ a(2) = 1.0
+ if (minloc (a, dim = 1, mask = l).ne.2) call abort
+ if (minval (a, dim = 1, mask = l).ne.1) call abort
+ if (minloc (a, dim = 1, mask = l2).ne.2) call abort
+ if (minval (a, dim = 1, mask = l2).ne.1) call abort
+ a(2) = minf
+ if (minloc (a, dim = 1, mask = l).ne.2) call abort
+ if (minval (a, dim = 1, mask = l).ne.minf) call abort
+ if (minloc (a, dim = 1, mask = l2).ne.2) call abort
+ if (minval (a, dim = 1, mask = l2).ne.minf) call abort
+ c(:) = nan
+ if (minloc (c, dim = 1, mask = l).ne.1) call abort
+ if (.not.isnan(minval (c, dim = 1, mask = l))) call abort
+ if (minloc (c, dim = 1, mask = l2).ne.1) call abort
+ if (.not.isnan(minval (c, dim = 1, mask = l2))) call abort
+ c(:) = pinf
+ if (minloc (c, dim = 1, mask = l).ne.1) call abort
+ if (minval (c, dim = 1, mask = l).ne.pinf) call abort
+ if (minloc (c, dim = 1, mask = l2).ne.1) call abort
+ if (minval (c, dim = 1, mask = l2).ne.pinf) call abort
+ c(1:2) = nan
+ if (minloc (c, dim = 1, mask = l).ne.3) call abort
+ if (minval (c, dim = 1, mask = l).ne.pinf) call abort
+ if (minloc (c, dim = 1, mask = l2).ne.3) call abort
+ if (minval (c, dim = 1, mask = l2).ne.pinf) call abort
+ c(2) = 1.0
+ if (minloc (c, dim = 1, mask = l).ne.2) call abort
+ if (minval (c, dim = 1, mask = l).ne.1) call abort
+ if (minloc (c, dim = 1, mask = l2).ne.2) call abort
+ if (minval (c, dim = 1, mask = l2).ne.1) call abort
+ c(2) = minf
+ if (minloc (c, dim = 1, mask = l).ne.2) call abort
+ if (minval (c, dim = 1, mask = l).ne.minf) call abort
+ if (minloc (c, dim = 1, mask = l2).ne.2) call abort
+ if (minval (c, dim = 1, mask = l2).ne.minf) call abort
+ deallocate (c)
+ allocate (c(-2:-3))
+ if (minloc (c, dim = 1).ne.0) call abort
+ if (minval (c, dim = 1).ne.huge(pinf)) call abort
+end
Jakub