aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorJakub Jelinek <jakub@redhat.com>2011-07-28 22:56:50 +0200
committerJakub Jelinek <jakub@gcc.gnu.org>2011-07-28 22:56:50 +0200
commitd266391244dae81f7f1693d9927df4c6c1bc146b (patch)
tree84fa0235e700ee8b97d41dd0db663877ac961ad1 /gcc
parent5fce91262c0d0ecedb53090544f227106bf3cbf4 (diff)
downloadgcc-d266391244dae81f7f1693d9927df4c6c1bc146b.zip
gcc-d266391244dae81f7f1693d9927df4c6c1bc146b.tar.gz
gcc-d266391244dae81f7f1693d9927df4c6c1bc146b.tar.bz2
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
Diffstat (limited to 'gcc')
-rw-r--r--gcc/fortran/ChangeLog6
-rw-r--r--gcc/fortran/frontend-passes.c57
-rw-r--r--gcc/testsuite/ChangeLog8
-rw-r--r--gcc/testsuite/gfortran.dg/maxloc_2.f90156
-rw-r--r--gcc/testsuite/gfortran.dg/maxloc_3.f90122
-rw-r--r--gcc/testsuite/gfortran.dg/minloc_1.f90156
-rw-r--r--gcc/testsuite/gfortran.dg/minloc_2.f90122
-rw-r--r--gcc/testsuite/gfortran.dg/minloc_3.f9094
-rw-r--r--gcc/testsuite/gfortran.dg/minmaxloc_7.f9021
9 files changed, 741 insertions, 1 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 275285e..89825e3 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2011-07-28 Jakub Jelinek <jakub@redhat.com>
+
+ PR fortran/31067
+ * frontend-passes.c (optimize_minmaxloc): New function.
+ (optimize_expr): Call it.
+
2011-07-27 Tobias Burnus <burnus@net-b.de>
PR fortran/45586
diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c
index 4d8c77a..5c3e280 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 e583713..9e9efb1 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,13 @@
2011-07-28 Jakub Jelinek <jakub@redhat.com>
+ 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 0000000..deca9fc
--- /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 0000000..c89e874
--- /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 0000000..25691b0
--- /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 0000000..7a659f7
--- /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 0000000..b1655e9
--- /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 0000000..2645a96
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/minmaxloc_7.f90
@@ -0,0 +1,21 @@
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+! { 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