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:
parent
5fce91262c
commit
d266391244
|
@ -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
|
||||
|
|
|
@ -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 \
|
||||
{ \
|
||||
|
|
|
@ -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.
|
||||
|
||||
|
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
Loading…
Reference in New Issue