This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[PATCH] Optimize minloc (rank1array) and maxloc (rank1array) (PR fortran/31067)


Hi!

The minloc/maxloc intrinsics without DIM argument used on rank 1 arrays
aren't inline optimized, because unlike their DIM=1 counterparts they
return a rank 1 array with size 1.  Handling that during genericization
looked too hard to me, so instead this patch optimizes
minloc (a)
for rank 1 a into (/ minloc (a, dim=1) /) during frontend optimizations.
Bootstrapped/regtested on x86_64-linux and i686-linux, ok for trunk?

2011-07-28  Jakub Jelinek  <jakub@redhat.com>

	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.

--- gcc/fortran/frontend-passes.c.jj	2011-06-17 11:02:01.000000000 +0200
+++ gcc/fortran/frontend-passes.c	2011-07-28 19:08:52.000000000 +0200
@@ -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_s
   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 +875,49 @@ optimize_trim (gfc_expr *e)
   return true;
 }
 
+/* Optimize a = minloc(b), where b is rank 1 array, into
+   a = 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/gfortran.dg/maxloc_2.f90.jj	2011-07-28 19:52:05.000000000 +0200
+++ gcc/testsuite/gfortran.dg/maxloc_2.f90	2011-07-28 19:53:09.000000000 +0200
@@ -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
--- gcc/testsuite/gfortran.dg/maxloc_3.f90.jj	2011-07-28 19:52:10.000000000 +0200
+++ gcc/testsuite/gfortran.dg/maxloc_3.f90	2011-07-28 19:54:06.000000000 +0200
@@ -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
--- gcc/testsuite/gfortran.dg/minloc_1.f90.jj	2011-07-28 19:38:21.000000000 +0200
+++ gcc/testsuite/gfortran.dg/minloc_1.f90	2011-07-28 20:09:59.000000000 +0200
@@ -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
--- gcc/testsuite/gfortran.dg/minloc_2.f90.jj	2011-07-28 19:38:25.000000000 +0200
+++ gcc/testsuite/gfortran.dg/minloc_2.f90	2011-07-28 19:36:27.000000000 +0200
@@ -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
--- gcc/testsuite/gfortran.dg/minloc_3.f90.jj	2011-07-28 19:38:28.000000000 +0200
+++ gcc/testsuite/gfortran.dg/minloc_3.f90	2011-07-28 19:37:37.000000000 +0200
@@ -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
--- gcc/testsuite/gfortran.dg/minmaxloc_7.f90.jj	2011-07-28 19:13:53.000000000 +0200
+++ gcc/testsuite/gfortran.dg/minmaxloc_7.f90	2011-07-28 19:14:28.000000000 +0200
@@ -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

	Jakub


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]