Skip to content

R
riscv-gcc-1
Commit d2663912 by Jakub Jelinek Committed by Jakub Jelinek
Options

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
parent 5fce9126
Showing with 741 additions and 1 deletions
gcc/fortran/ChangeLog
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
......
gcc/fortran/frontend-passes.c
/* 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 \
{ \
......
gcc/testsuite/ChangeLog
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.
......
gcc/testsuite/gfortran.dg/maxloc_2.f90 0 → 100644
! { 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
gcc/testsuite/gfortran.dg/maxloc_3.f90 0 → 100644
! { 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
gcc/testsuite/gfortran.dg/minloc_1.f90 0 → 100644
! { 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
gcc/testsuite/gfortran.dg/minloc_2.f90 0 → 100644
! { 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
gcc/testsuite/gfortran.dg/minloc_3.f90 0 → 100644
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
gcc/testsuite/gfortran.dg/minmaxloc_7.f90 0 → 100644
! 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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment