trans-intrinsic.c (gfc_conv_intrinsic_minmaxloc): If the mask expression exists and...

2006-02-28  Thomas Koenig  <Thomas.Koenig@online.de>

	* trans-intrinsic.c (gfc_conv_intrinsic_minmaxloc):
	If the mask expression exists and has rank 0, enclose the
	generated loop in an "if (mask)".  Put the default
	initialization into the else branch.

2006-02-28  Thomas Koenig  <Thomas.Koenig@online.de>

	* scalar_mask_1.f90:  Add tests for maxloc with scalar mask.

From-SVN: r111562

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index b1172ba..8ed4f91 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2006-02-28  Thomas Koenig  <Thomas.Koenig@online.de>
+
+       * trans-intrinsic.c (gfc_conv_intrinsic_minmaxloc):
+       If the mask expression exists and has rank 0, enclose the
+       generated loop in an "if (mask)".  Put the default
+       initialization into the else branch.
+
 2006-02-25  Thomas Koenig  <Thomas.Koenig@online.de>
 
        PR fortran/23092

diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 21477b1..f58a596 100644 (file)
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -1567,9 +1567,11 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, int op)
   stmtblock_t body;
   stmtblock_t block;
   stmtblock_t ifblock;
+  stmtblock_t elseblock;
   tree limit;
   tree type;
   tree tmp;
+  tree elsetmp;
   tree ifbody;
   tree cond;
   gfc_loopinfo loop;
@@ -1602,7 +1604,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, int op)
   actual = actual->next->next;
   gcc_assert (actual);
   maskexpr = actual->expr;
-  if (maskexpr)
+  if (maskexpr && maskexpr->rank != 0)
     {
       maskss = gfc_walk_expr (maskexpr);
       gcc_assert (maskss != gfc_ss_terminator);
@@ -1712,8 +1714,39 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, int op)
 
   gfc_trans_scalarizing_loops (&loop, &body);
 
-  gfc_add_block_to_block (&se->pre, &loop.pre);
-  gfc_add_block_to_block (&se->pre, &loop.post);
+  /* For a scalar mask, enclose the loop in an if statement.  */
+  if (maskexpr && maskss == NULL)
+    {
+      gfc_init_se (&maskse, NULL);
+      gfc_conv_expr_val (&maskse, maskexpr);
+      gfc_init_block (&block);
+      gfc_add_block_to_block (&block, &loop.pre);
+      gfc_add_block_to_block (&block, &loop.post);
+      tmp = gfc_finish_block (&block);
+
+      /* For the else part of the scalar mask, just initialize
+        the pos variable the same way as above.  */
+
+      gfc_init_block (&elseblock);
+
+      elsetmp = fold_build2 (MINUS_EXPR, gfc_array_index_type,
+                            loop.from[0], gfc_index_one_node);
+      cond = fold_build2 (GE_EXPR, boolean_type_node,
+                         loop.to[0], loop.from[0]);
+      elsetmp = fold_build3 (COND_EXPR, gfc_array_index_type, cond,
+                         loop.from[0], elsetmp);
+      gfc_add_modify_expr (&elseblock, pos, elsetmp);
+      elsetmp = gfc_finish_block (&elseblock);
+
+      tmp = build3_v (COND_EXPR, maskse.expr, tmp, elsetmp);
+      gfc_add_expr_to_block (&block, tmp);
+      gfc_add_block_to_block (&se->pre, &block);
+    }
+  else
+    {
+      gfc_add_block_to_block (&se->pre, &loop.pre);
+      gfc_add_block_to_block (&se->pre, &loop.post);
+    }
   gfc_cleanup_loop (&loop);
 
   /* Return a value in the range 1..SIZE(array).  */

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 5246dd9..f1ce569 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2006-02-28  Thomas Koenig  <Thomas.Koenig@online.de>
+
+       * scalar_mask_1.f90:  Add tests for maxloc with scalar mask.
+
 2006-02-27  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
        PR libgfortran/26464

diff --git a/gcc/testsuite/gfortran.dg/scalar_mask_1.f90 b/gcc/testsuite/gfortran.dg/scalar_mask_1.f90
index 4f2a877..01bef2c 100644 (file)
--- a/gcc/testsuite/gfortran.dg/scalar_mask_1.f90
+++ b/gcc/testsuite/gfortran.dg/scalar_mask_1.f90
@@ -10,4 +10,6 @@ program main
   if (sum (a, .true.) /= 5.0) call abort
   if (maxval (a, .true.) /= 3.0) call abort
   if (maxval (a, .false.) > -1e38) call abort
+  if (maxloc (a, 1, .true.) /= 2) call abort
+  if (maxloc (a, 1, .false.) /= 1) call abort
 end program main