OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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
This commit is contained in:
Jakub Jelinek 2011-07-28 22:56:50 +02:00 committed by Jakub Jelinek
parent 5fce91262c
commit d266391244
9 changed files with 741 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View File

@ -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

57
gcc/fortran/frontend-passes.c
View File

@ -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 \
{ \

8
gcc/testsuite/ChangeLog
View File

@ -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.

156
gcc/testsuite/gfortran.dg/maxloc_2.f90 Normal file
View File

@ -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

122
gcc/testsuite/gfortran.dg/maxloc_3.f90 Normal file
View File

@ -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

156
gcc/testsuite/gfortran.dg/minloc_1.f90 Normal file
View File

@ -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

122
gcc/testsuite/gfortran.dg/minloc_2.f90 Normal file
View File

@ -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

94
gcc/testsuite/gfortran.dg/minloc_3.f90 Normal file
View File

@ -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

21
gcc/testsuite/gfortran.dg/minmaxloc_7.f90 Normal file
View File

@ -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