From d266391244dae81f7f1693d9927df4c6c1bc146b Mon Sep 17 00:00:00 2001 From: Jakub Jelinek Date: Thu, 28 Jul 2011 22:56:50 +0200 Subject: [PATCH] re PR fortran/31067 (MINLOC should sometimes be inlined (gas_dyn is sooooo sloooow)) PR fortran/31067 * frontend-passes.c (optimize_minmaxloc): New function. (optimize_expr): Call it. * gfortran.dg/maxloc_2.f90: New test. * gfortran.dg/maxloc_3.f90: New test. * gfortran.dg/minloc_1.f90: New test. * gfortran.dg/minloc_2.f90: New test. * gfortran.dg/minloc_3.f90: New test. * gfortran.dg/minmaxloc_7.f90: New test. From-SVN: r176897 --- gcc/fortran/ChangeLog | 6 + gcc/fortran/frontend-passes.c | 57 +++++++- gcc/testsuite/ChangeLog | 8 ++ gcc/testsuite/gfortran.dg/maxloc_2.f90 | 156 ++++++++++++++++++++++ gcc/testsuite/gfortran.dg/maxloc_3.f90 | 122 +++++++++++++++++ gcc/testsuite/gfortran.dg/minloc_1.f90 | 156 ++++++++++++++++++++++ gcc/testsuite/gfortran.dg/minloc_2.f90 | 122 +++++++++++++++++ gcc/testsuite/gfortran.dg/minloc_3.f90 | 94 +++++++++++++ gcc/testsuite/gfortran.dg/minmaxloc_7.f90 | 21 +++ 9 files changed, 741 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/maxloc_2.f90 create mode 100644 gcc/testsuite/gfortran.dg/maxloc_3.f90 create mode 100644 gcc/testsuite/gfortran.dg/minloc_1.f90 create mode 100644 gcc/testsuite/gfortran.dg/minloc_2.f90 create mode 100644 gcc/testsuite/gfortran.dg/minloc_3.f90 create mode 100644 gcc/testsuite/gfortran.dg/minmaxloc_7.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 275285e5360..89825e35cc4 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2011-07-28 Jakub Jelinek + + PR fortran/31067 + * frontend-passes.c (optimize_minmaxloc): New function. + (optimize_expr): Call it. + 2011-07-27 Tobias Burnus PR fortran/45586 diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index 4d8c77a1269..5c3e280df1c 100644 --- a/gcc/fortran/frontend-passes.c +++ b/gcc/fortran/frontend-passes.c @@ -1,5 +1,5 @@ /* Pass manager for Fortran front end. - Copyright (C) 2010 Free Software Foundation, Inc. + Copyright (C) 2010, 2011 Free Software Foundation, Inc. Contributed by Thomas König. This file is part of GCC. @@ -36,6 +36,7 @@ static bool optimize_op (gfc_expr *); static bool optimize_comparison (gfc_expr *, gfc_intrinsic_op); static bool optimize_trim (gfc_expr *); static bool optimize_lexical_comparison (gfc_expr *); +static void optimize_minmaxloc (gfc_expr **); /* How deep we are inside an argument list. */ @@ -129,6 +130,17 @@ optimize_expr (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED, if ((*e)->expr_type == EXPR_OP && optimize_op (*e)) gfc_simplify_expr (*e, 0); + if ((*e)->expr_type == EXPR_FUNCTION && (*e)->value.function.isym) + switch ((*e)->value.function.isym->id) + { + case GFC_ISYM_MINLOC: + case GFC_ISYM_MAXLOC: + optimize_minmaxloc (e); + break; + default: + break; + } + if (function_expr) count_arglist --; @@ -862,6 +874,49 @@ optimize_trim (gfc_expr *e) return true; } +/* Optimize minloc(b), where b is rank 1 array, into + (/ minloc(b, dim=1) /), and similarly for maxloc, + as the latter forms are expanded inline. */ + +static void +optimize_minmaxloc (gfc_expr **e) +{ + gfc_expr *fn = *e; + gfc_actual_arglist *a; + char *name, *p; + + if (fn->rank != 1 + || fn->value.function.actual == NULL + || fn->value.function.actual->expr == NULL + || fn->value.function.actual->expr->rank != 1) + return; + + *e = gfc_get_array_expr (fn->ts.type, fn->ts.kind, &fn->where); + (*e)->shape = fn->shape; + fn->rank = 0; + fn->shape = NULL; + gfc_constructor_append_expr (&(*e)->value.constructor, fn, &fn->where); + + name = XALLOCAVEC (char, strlen (fn->value.function.name) + 1); + strcpy (name, fn->value.function.name); + p = strstr (name, "loc0"); + p[3] = '1'; + fn->value.function.name = gfc_get_string (name); + if (fn->value.function.actual->next) + { + a = fn->value.function.actual->next; + gcc_assert (a->expr == NULL); + } + else + { + a = gfc_get_actual_arglist (); + fn->value.function.actual->next = a; + } + a->expr = gfc_get_constant_expr (BT_INTEGER, gfc_default_integer_kind, + &fn->where); + mpz_set_ui (a->expr->value.integer, 1); +} + #define WALK_SUBEXPR(NODE) \ do \ { \ diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index e5837139646..9e9efb19b64 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,5 +1,13 @@ 2011-07-28 Jakub Jelinek + PR fortran/31067 + * gfortran.dg/maxloc_2.f90: New test. + * gfortran.dg/maxloc_3.f90: New test. + * gfortran.dg/minloc_1.f90: New test. + * gfortran.dg/minloc_2.f90: New test. + * gfortran.dg/minloc_3.f90: New test. + * gfortran.dg/minmaxloc_7.f90: New test. + PR debug/49871 * gcc.dg/debug/dwarf2/pr49871.c: New test. diff --git a/gcc/testsuite/gfortran.dg/maxloc_2.f90 b/gcc/testsuite/gfortran.dg/maxloc_2.f90 new file mode 100644 index 00000000000..deca9fc4427 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/maxloc_2.f90 @@ -0,0 +1,156 @@ +! { dg-do run } +! { dg-add-options ieee } +! { dg-skip-if "NaN not supported" { spu-*-* } { "*" } { "" } } + real :: a(3), nan, minf, pinf + real, allocatable :: c(:) + integer :: ia(1) + 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 + ia = maxloc (a) + if (ia(1).ne.1) call abort + a(:) = minf + ia = maxloc (a) + if (ia(1).ne.1) call abort + a(1:2) = nan + ia = maxloc (a) + if (ia(1).ne.3) call abort + a(2) = 1.0 + ia = maxloc (a) + if (ia(1).ne.2) call abort + a(2) = pinf + ia = maxloc (a) + if (ia(1).ne.2) call abort + c(:) = nan + ia = maxloc (c) + if (ia(1).ne.1) call abort + c(:) = minf + ia = maxloc (c) + if (ia(1).ne.1) call abort + c(1:2) = nan + ia = maxloc (c) + if (ia(1).ne.3) call abort + c(2) = 1.0 + ia = maxloc (c) + if (ia(1).ne.2) call abort + c(2) = pinf + ia = maxloc (c) + if (ia(1).ne.2) call abort + l = .false. + l2(:) = .false. + a(:) = nan + ia = maxloc (a, mask = l) + if (ia(1).ne.0) call abort + ia = maxloc (a, mask = l2) + if (ia(1).ne.0) call abort + a(:) = minf + ia = maxloc (a, mask = l) + if (ia(1).ne.0) call abort + ia = maxloc (a, mask = l2) + if (ia(1).ne.0) call abort + a(1:2) = nan + ia = maxloc (a, mask = l) + if (ia(1).ne.0) call abort + ia = maxloc (a, mask = l2) + if (ia(1).ne.0) call abort + a(2) = 1.0 + ia = maxloc (a, mask = l) + if (ia(1).ne.0) call abort + ia = maxloc (a, mask = l2) + if (ia(1).ne.0) call abort + a(2) = pinf + ia = maxloc (a, mask = l) + if (ia(1).ne.0) call abort + ia = maxloc (a, mask = l2) + if (ia(1).ne.0) call abort + c(:) = nan + ia = maxloc (c, mask = l) + if (ia(1).ne.0) call abort + ia = maxloc (c, mask = l2) + if (ia(1).ne.0) call abort + c(:) = minf + ia = maxloc (c, mask = l) + if (ia(1).ne.0) call abort + ia = maxloc (c, mask = l2) + if (ia(1).ne.0) call abort + c(1:2) = nan + ia = maxloc (c, mask = l) + if (ia(1).ne.0) call abort + ia = maxloc (c, mask = l2) + if (ia(1).ne.0) call abort + c(2) = 1.0 + ia = maxloc (c, mask = l) + if (ia(1).ne.0) call abort + ia = maxloc (c, mask = l2) + if (ia(1).ne.0) call abort + c(2) = pinf + ia = maxloc (c, mask = l) + if (ia(1).ne.0) call abort + ia = maxloc (c, mask = l2) + if (ia(1).ne.0) call abort + l = .true. + l2(:) = .true. + a(:) = nan + ia = maxloc (a, mask = l) + if (ia(1).ne.1) call abort + ia = maxloc (a, mask = l2) + if (ia(1).ne.1) call abort + a(:) = minf + ia = maxloc (a, mask = l) + if (ia(1).ne.1) call abort + ia = maxloc (a, mask = l2) + if (ia(1).ne.1) call abort + a(1:2) = nan + ia = maxloc (a, mask = l) + if (ia(1).ne.3) call abort + ia = maxloc (a, mask = l2) + if (ia(1).ne.3) call abort + a(2) = 1.0 + ia = maxloc (a, mask = l) + if (ia(1).ne.2) call abort + ia = maxloc (a, mask = l2) + if (ia(1).ne.2) call abort + a(2) = pinf + ia = maxloc (a, mask = l) + if (ia(1).ne.2) call abort + ia = maxloc (a, mask = l2) + if (ia(1).ne.2) call abort + c(:) = nan + ia = maxloc (c, mask = l) + if (ia(1).ne.1) call abort + ia = maxloc (c, mask = l2) + if (ia(1).ne.1) call abort + c(:) = minf + ia = maxloc (c, mask = l) + if (ia(1).ne.1) call abort + ia = maxloc (c, mask = l2) + if (ia(1).ne.1) call abort + c(1:2) = nan + ia = maxloc (c, mask = l) + if (ia(1).ne.3) call abort + ia = maxloc (c, mask = l2) + if (ia(1).ne.3) call abort + c(2) = 1.0 + ia = maxloc (c, mask = l) + if (ia(1).ne.2) call abort + ia = maxloc (c, mask = l2) + if (ia(1).ne.2) call abort + c(2) = pinf + ia = maxloc (c, mask = l) + if (ia(1).ne.2) call abort + ia = maxloc (c, mask = l2) + if (ia(1).ne.2) call abort + deallocate (c) + allocate (c(-2:-3)) + ia = maxloc (c) + if (ia(1).ne.0) call abort +end diff --git a/gcc/testsuite/gfortran.dg/maxloc_3.f90 b/gcc/testsuite/gfortran.dg/maxloc_3.f90 new file mode 100644 index 00000000000..c89e8749c09 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/maxloc_3.f90 @@ -0,0 +1,122 @@ +! { dg-do run } + integer :: a(3), h, ia(1) + integer, allocatable :: c(:) + logical :: l + logical :: l2(3) + + h = -huge(h) + h = h - 1 + allocate (c(3)) + a(:) = 5 + ia = maxloc (a) + if (ia(1).ne.1) call abort + a(2) = huge(h) + ia = maxloc (a) + if (ia(1).ne.2) call abort + a(:) = h + ia = maxloc (a) + if (ia(1).ne.1) call abort + a(3) = -huge(h) + ia = maxloc (a) + if (ia(1).ne.3) call abort + c(:) = 5 + ia = maxloc (c) + if (ia(1).ne.1) call abort + c(2) = huge(h) + ia = maxloc (c) + if (ia(1).ne.2) call abort + c(:) = h + ia = maxloc (c) + if (ia(1).ne.1) call abort + c(3) = -huge(h) + ia = maxloc (c) + if (ia(1).ne.3) call abort + l = .false. + l2(:) = .false. + a(:) = 5 + ia = maxloc (a, mask = l) + if (ia(1).ne.0) call abort + ia = maxloc (a, mask = l2) + if (ia(1).ne.0) call abort + a(2) = huge(h) + ia = maxloc (a, mask = l) + if (ia(1).ne.0) call abort + ia = maxloc (a, mask = l2) + if (ia(1).ne.0) call abort + a(:) = h + ia = maxloc (a, mask = l) + if (ia(1).ne.0) call abort + ia = maxloc (a, mask = l2) + if (ia(1).ne.0) call abort + a(3) = -huge(h) + ia = maxloc (a, mask = l) + if (ia(1).ne.0) call abort + ia = maxloc (a, mask = l2) + if (ia(1).ne.0) call abort + c(:) = 5 + ia = maxloc (c, mask = l) + if (ia(1).ne.0) call abort + ia = maxloc (c, mask = l2) + if (ia(1).ne.0) call abort + c(2) = huge(h) + ia = maxloc (c, mask = l) + if (ia(1).ne.0) call abort + ia = maxloc (c, mask = l2) + if (ia(1).ne.0) call abort + c(:) = h + ia = maxloc (c, mask = l) + if (ia(1).ne.0) call abort + ia = maxloc (c, mask = l2) + if (ia(1).ne.0) call abort + c(3) = -huge(h) + ia = maxloc (c, mask = l) + if (ia(1).ne.0) call abort + ia = maxloc (c, mask = l2) + if (ia(1).ne.0) call abort + l = .true. + l2(:) = .true. + a(:) = 5 + ia = maxloc (a, mask = l) + if (ia(1).ne.1) call abort + ia = maxloc (a, mask = l2) + if (ia(1).ne.1) call abort + a(2) = huge(h) + ia = maxloc (a, mask = l) + if (ia(1).ne.2) call abort + ia = maxloc (a, mask = l2) + if (ia(1).ne.2) call abort + a(:) = h + ia = maxloc (a, mask = l) + if (ia(1).ne.1) call abort + ia = maxloc (a, mask = l2) + if (ia(1).ne.1) call abort + a(3) = -huge(h) + ia = maxloc (a, mask = l) + if (ia(1).ne.3) call abort + ia = maxloc (a, mask = l2) + if (ia(1).ne.3) call abort + c(:) = 5 + ia = maxloc (c, mask = l) + if (ia(1).ne.1) call abort + ia = maxloc (c, mask = l2) + if (ia(1).ne.1) call abort + c(2) = huge(h) + ia = maxloc (c, mask = l) + if (ia(1).ne.2) call abort + ia = maxloc (c, mask = l2) + if (ia(1).ne.2) call abort + c(:) = h + ia = maxloc (c, mask = l) + if (ia(1).ne.1) call abort + ia = maxloc (c, mask = l2) + if (ia(1).ne.1) call abort + c(3) = -huge(h) + ia = maxloc (c, mask = l) + if (ia(1).ne.3) call abort + ia = maxloc (c, mask = l2) + if (ia(1).ne.3) call abort + deallocate (c) + allocate (c(-2:-3)) + ia = maxloc (c) + if (ia(1).ne.0) call abort +end diff --git a/gcc/testsuite/gfortran.dg/minloc_1.f90 b/gcc/testsuite/gfortran.dg/minloc_1.f90 new file mode 100644 index 00000000000..25691b0682a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/minloc_1.f90 @@ -0,0 +1,156 @@ +! { dg-do run } +! { dg-add-options ieee } +! { dg-skip-if "NaN not supported" { spu-*-* } { "*" } { "" } } + real :: a(3), nan, minf, pinf + integer :: ia(1) + 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 + ia = minloc (a) + if (ia(1).ne.1) call abort + a(:) = pinf + ia = minloc (a) + if (ia(1).ne.1) call abort + a(1:2) = nan + ia = minloc (a) + if (ia(1).ne.3) call abort + a(2) = 1.0 + ia = minloc (a) + if (ia(1).ne.2) call abort + a(2) = minf + ia = minloc (a) + if (ia(1).ne.2) call abort + c(:) = nan + ia = minloc (c) + if (ia(1).ne.1) call abort + c(:) = pinf + ia = minloc (c) + if (ia(1).ne.1) call abort + c(1:2) = nan + ia = minloc (c) + if (ia(1).ne.3) call abort + c(2) = 1.0 + ia = minloc (c) + if (ia(1).ne.2) call abort + c(2) = minf + ia = minloc (c) + if (ia(1).ne.2) call abort + l = .false. + l2(:) = .false. + a(:) = nan + ia = minloc (a, mask = l) + if (ia(1).ne.0) call abort + ia = minloc (a, mask = l2) + if (ia(1).ne.0) call abort + a(:) = pinf + ia = minloc (a, mask = l) + if (ia(1).ne.0) call abort + ia = minloc (a, mask = l2) + if (ia(1).ne.0) call abort + a(1:2) = nan + ia = minloc (a, mask = l) + if (ia(1).ne.0) call abort + ia = minloc (a, mask = l2) + if (ia(1).ne.0) call abort + a(2) = 1.0 + ia = minloc (a, mask = l) + if (ia(1).ne.0) call abort + ia = minloc (a, mask = l2) + if (ia(1).ne.0) call abort + a(2) = minf + ia = minloc (a, mask = l) + if (ia(1).ne.0) call abort + ia = minloc (a, mask = l2) + if (ia(1).ne.0) call abort + c(:) = nan + ia = minloc (c, mask = l) + if (ia(1).ne.0) call abort + ia = minloc (c, mask = l2) + if (ia(1).ne.0) call abort + c(:) = pinf + ia = minloc (c, mask = l) + if (ia(1).ne.0) call abort + ia = minloc (c, mask = l2) + if (ia(1).ne.0) call abort + c(1:2) = nan + ia = minloc (c, mask = l) + if (ia(1).ne.0) call abort + ia = minloc (c, mask = l2) + if (ia(1).ne.0) call abort + c(2) = 1.0 + ia = minloc (c, mask = l) + if (ia(1).ne.0) call abort + ia = minloc (c, mask = l2) + if (ia(1).ne.0) call abort + c(2) = minf + ia = minloc (c, mask = l) + if (ia(1).ne.0) call abort + ia = minloc (c, mask = l2) + if (ia(1).ne.0) call abort + l = .true. + l2(:) = .true. + a(:) = nan + ia = minloc (a, mask = l) + if (ia(1).ne.1) call abort + ia = minloc (a, mask = l2) + if (ia(1).ne.1) call abort + a(:) = pinf + ia = minloc (a, mask = l) + if (ia(1).ne.1) call abort + ia = minloc (a, mask = l2) + if (ia(1).ne.1) call abort + a(1:2) = nan + ia = minloc (a, mask = l) + if (ia(1).ne.3) call abort + ia = minloc (a, mask = l2) + if (ia(1).ne.3) call abort + a(2) = 1.0 + ia = minloc (a, mask = l) + if (ia(1).ne.2) call abort + ia = minloc (a, mask = l2) + if (ia(1).ne.2) call abort + a(2) = minf + ia = minloc (a, mask = l) + if (ia(1).ne.2) call abort + ia = minloc (a, mask = l2) + if (ia(1).ne.2) call abort + c(:) = nan + ia = minloc (c, mask = l) + if (ia(1).ne.1) call abort + ia = minloc (c, mask = l2) + if (ia(1).ne.1) call abort + c(:) = pinf + ia = minloc (c, mask = l) + if (ia(1).ne.1) call abort + ia = minloc (c, mask = l2) + if (ia(1).ne.1) call abort + c(1:2) = nan + ia = minloc (c, mask = l) + if (ia(1).ne.3) call abort + ia = minloc (c, mask = l2) + if (ia(1).ne.3) call abort + c(2) = 1.0 + ia = minloc (c, mask = l) + if (ia(1).ne.2) call abort + ia = minloc (c, mask = l2) + if (ia(1).ne.2) call abort + c(2) = minf + ia = minloc (c, mask = l) + if (ia(1).ne.2) call abort + ia = minloc (c, mask = l2) + if (ia(1).ne.2) call abort + deallocate (c) + allocate (c(-2:-3)) + ia = minloc (c) + if (ia(1).ne.0) call abort +end diff --git a/gcc/testsuite/gfortran.dg/minloc_2.f90 b/gcc/testsuite/gfortran.dg/minloc_2.f90 new file mode 100644 index 00000000000..7a659f786c9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/minloc_2.f90 @@ -0,0 +1,122 @@ +! { dg-do run } + integer :: a(3), h, ia(1) + integer, allocatable :: c(:) + logical :: l + logical :: l2(3) + + h = -huge(h) + h = h - 1 + allocate (c(3)) + a(:) = 5 + ia = minloc (a) + if (ia(1).ne.1) call abort + a(2) = h + ia = minloc (a) + if (ia(1).ne.2) call abort + a(:) = huge(h) + ia = minloc (a) + if (ia(1).ne.1) call abort + a(3) = huge(h) - 1 + ia = minloc (a) + if (ia(1).ne.3) call abort + c(:) = 5 + ia = minloc (c) + if (ia(1).ne.1) call abort + c(2) = h + ia = minloc (c) + if (ia(1).ne.2) call abort + c(:) = huge(h) + ia = minloc (c) + if (ia(1).ne.1) call abort + c(3) = huge(h) - 1 + ia = minloc (c) + if (ia(1).ne.3) call abort + l = .false. + l2(:) = .false. + a(:) = 5 + ia = minloc (a, mask = l) + if (ia(1).ne.0) call abort + ia = minloc (a, mask = l2) + if (ia(1).ne.0) call abort + a(2) = h + ia = minloc (a, mask = l) + if (ia(1).ne.0) call abort + ia = minloc (a, mask = l2) + if (ia(1).ne.0) call abort + a(:) = huge(h) + ia = minloc (a, mask = l) + if (ia(1).ne.0) call abort + ia = minloc (a, mask = l2) + if (ia(1).ne.0) call abort + a(3) = huge(h) - 1 + ia = minloc (a, mask = l) + if (ia(1).ne.0) call abort + ia = minloc (a, mask = l2) + if (ia(1).ne.0) call abort + c(:) = 5 + ia = minloc (c, mask = l) + if (ia(1).ne.0) call abort + ia = minloc (c, mask = l2) + if (ia(1).ne.0) call abort + c(2) = h + ia = minloc (c, mask = l) + if (ia(1).ne.0) call abort + ia = minloc (c, mask = l2) + if (ia(1).ne.0) call abort + c(:) = huge(h) + ia = minloc (c, mask = l) + if (ia(1).ne.0) call abort + ia = minloc (c, mask = l2) + if (ia(1).ne.0) call abort + c(3) = huge(h) - 1 + ia = minloc (c, mask = l) + if (ia(1).ne.0) call abort + ia = minloc (c, mask = l2) + if (ia(1).ne.0) call abort + l = .true. + l2(:) = .true. + a(:) = 5 + ia = minloc (a, mask = l) + if (ia(1).ne.1) call abort + ia = minloc (a, mask = l2) + if (ia(1).ne.1) call abort + a(2) = h + ia = minloc (a, mask = l) + if (ia(1).ne.2) call abort + ia = minloc (a, mask = l2) + if (ia(1).ne.2) call abort + a(:) = huge(h) + ia = minloc (a, mask = l) + if (ia(1).ne.1) call abort + ia = minloc (a, mask = l2) + if (ia(1).ne.1) call abort + a(3) = huge(h) - 1 + ia = minloc (a, mask = l) + if (ia(1).ne.3) call abort + ia = minloc (a, mask = l2) + if (ia(1).ne.3) call abort + c(:) = 5 + ia = minloc (c, mask = l) + if (ia(1).ne.1) call abort + ia = minloc (c, mask = l2) + if (ia(1).ne.1) call abort + c(2) = h + ia = minloc (c, mask = l) + if (ia(1).ne.2) call abort + ia = minloc (c, mask = l2) + if (ia(1).ne.2) call abort + c(:) = huge(h) + ia = minloc (c, mask = l) + if (ia(1).ne.1) call abort + ia = minloc (c, mask = l2) + if (ia(1).ne.1) call abort + c(3) = huge(h) - 1 + ia = minloc (c, mask = l) + if (ia(1).ne.3) call abort + ia = minloc (c, mask = l2) + if (ia(1).ne.3) call abort + deallocate (c) + allocate (c(-2:-3)) + ia = minloc (c) + if (ia(1).ne.0) call abort +end diff --git a/gcc/testsuite/gfortran.dg/minloc_3.f90 b/gcc/testsuite/gfortran.dg/minloc_3.f90 new file mode 100644 index 00000000000..b1655e98143 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/minloc_3.f90 @@ -0,0 +1,94 @@ + real :: a(30), m + real, allocatable :: c(:) + integer :: e(30), n, ia(1) + integer, allocatable :: g(:) + logical :: l(30) + allocate (c (30)) + allocate (g (30)) + a = 7.0 + c = 7.0 + e = 7 + g = 7 + m = huge(m) + n = huge(n) + a(7) = 6.0 + c(7) = 6.0 + e(7) = 6 + g(7) = 6 + ia = minloc (a) + if (ia(1).ne.7) call abort + ia = minloc (a(::2)) + if (ia(1).ne.4) call abort + if (any (minloc (a).ne.(/ 7 /))) call abort + if (any (minloc (a(::2)).ne.(/ 4 /))) call abort + ia = minloc (c) + if (ia(1).ne.7) call abort + ia = minloc (c(::2)) + if (ia(1).ne.4) call abort + if (any (minloc (c).ne.(/ 7 /))) call abort + if (any (minloc (c(::2)).ne.(/ 4 /))) call abort + ia = minloc (e) + if (ia(1).ne.7) call abort + ia = minloc (e(::2)) + if (ia(1).ne.4) call abort + if (any (minloc (e).ne.(/ 7 /))) call abort + if (any (minloc (e(::2)).ne.(/ 4 /))) call abort + ia = minloc (g) + if (ia(1).ne.7) call abort + ia = minloc (g(::2)) + if (ia(1).ne.4) call abort + if (any (minloc (g).ne.(/ 7 /))) call abort + if (any (minloc (g(::2)).ne.(/ 4 /))) call abort + l = .true. + ia = minloc (a, mask = l) + if (ia(1).ne.7) call abort + ia = minloc (a(::2), mask = l(::2)) + if (ia(1).ne.4) call abort + if (any (minloc (a, mask = l).ne.(/ 7 /))) call abort + if (any (minloc (a(::2), mask = l(::2)).ne.(/ 4 /))) call abort + ia = minloc (c, mask = l) + if (ia(1).ne.7) call abort + ia = minloc (c(::2), mask = l(::2)) + if (ia(1).ne.4) call abort + if (any (minloc (c, mask = l).ne.(/ 7 /))) call abort + if (any (minloc (c(::2), mask = l(::2)).ne.(/ 4 /))) call abort + ia = minloc (e, mask = l) + if (ia(1).ne.7) call abort + ia = minloc (e(::2), mask = l(::2)) + if (ia(1).ne.4) call abort + if (any (minloc (e, mask = l).ne.(/ 7 /))) call abort + if (any (minloc (e(::2), mask = l(::2)).ne.(/ 4 /))) call abort + ia = minloc (g, mask = l) + if (ia(1).ne.7) call abort + ia = minloc (g(::2), mask = l(::2)) + if (ia(1).ne.4) call abort + if (any (minloc (g, mask = l).ne.(/ 7 /))) call abort + if (any (minloc (g(::2), mask = l(::2)).ne.(/ 4 /))) call abort + l = .false. + ia = minloc (a, mask = l) + if (ia(1).ne.0) call abort + ia = minloc (a(::2), mask = l(::2)) + if (ia(1).ne.0) call abort + if (any (minloc (a, mask = l).ne.(/ 0 /))) call abort + if (any (minloc (a(::2), mask = l(::2)).ne.(/ 0 /))) call abort + ia = minloc (c, mask = l) + if (ia(1).ne.0) call abort + ia = minloc (c(::2), mask = l(::2)) + if (ia(1).ne.0) call abort + if (any (minloc (c, mask = l).ne.(/ 0 /))) call abort + if (any (minloc (c(::2), mask = l(::2)).ne.(/ 0 /))) call abort + ia = minloc (e, mask = l) + if (ia(1).ne.0) call abort + ia = minloc (e(::2), mask = l(::2)) + if (ia(1).ne.0) call abort + if (any (minloc (e, mask = l).ne.(/ 0 /))) call abort + if (any (minloc (e(::2), mask = l(::2)).ne.(/ 0 /))) call abort + ia = minloc (g, mask = l) + if (ia(1).ne.0) call abort + ia = minloc (g(::2), mask = l(::2)) + if (ia(1).ne.0) call abort + if (any (minloc (g, mask = l).ne.(/ 0 /))) call abort + if (any (minloc (g(::2), mask = l(::2)).ne.(/ 0 /))) call abort + a = 7.0 + c = 7.0 +end diff --git a/gcc/testsuite/gfortran.dg/minmaxloc_7.f90 b/gcc/testsuite/gfortran.dg/minmaxloc_7.f90 new file mode 100644 index 00000000000..2645a96e444 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/minmaxloc_7.f90 @@ -0,0 +1,21 @@ +! Contributed by Tobias Burnus +! { dg-do run } +program test + implicit none + real, volatile, allocatable :: A(:) + logical, volatile :: mask(11) + + A = [1,2,3,5,6,1,35,3,7,-3,-47] + mask = .true. + mask(7) = .false. + mask(11) = .false. + call sub2 (minloc(A),11) + call sub2 (maxloc(A, mask=mask),9) + A = minloc(A) + if (size (A) /= 1 .or. A(1) /= 11) call abort () +contains + subroutine sub2(A,n) + integer :: A(:),n + if (A(1) /= n .or. size (A) /= 1) call abort () + end subroutine sub2 +end program test -- 2.30.2