re PR fortran/23092 ([4.1 only] scalar mask for minval/maxval/sum/product)

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

	PR fortran/23092
	* trans-intrinsic.c (gfc_conv_intrinsic_arith):  If the
	mask expression exists and has rank 0, enclose the generated
	loop in an "if (mask)".
	* (gfc_conv_intrinsic_minmaxloc):  Likewise.

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

	PR fortran/23092
	* scalar_mask_1.f90:  New test.

From-SVN: r111438

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c5e6bfa6564542215d78f931d6a2e293b2861f2f..b1172ba3fc9dbca127c9f7cd8a44080560d183f1 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2006-02-25  Thomas Koenig  <Thomas.Koenig@online.de>
+
+       PR fortran/23092
+       * trans-intrinsic.c (gfc_conv_intrinsic_arith):  If the
+       mask expression exists and has rank 0, enclose the generated
+       loop in an "if (mask)".
+       * (gfc_conv_intrinsic_minmaxloc):  Likewise.
+
 2006-02-24  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/26409

diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 5b241a6a0fd71a413024098d6f6f5b84b09c5a0e..21477b126d40623f1b230103098bfc2d85a79d73 100644 (file)
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -1474,7 +1474,7 @@ gfc_conv_intrinsic_arith (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);
@@ -1535,8 +1535,27 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, int op)
   gfc_add_expr_to_block (&body, tmp);
 
   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);
+
+      tmp = build3_v (COND_EXPR, maskse.expr, tmp, build_empty_stmt ());
+      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);
 
   se->expr = resvar;
@@ -1762,7 +1781,7 @@ gfc_conv_intrinsic_minmaxval (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);
@@ -1824,8 +1843,26 @@ gfc_conv_intrinsic_minmaxval (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);
+
+      tmp = build3_v (COND_EXPR, maskse.expr, tmp, build_empty_stmt ());
+      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);
 
   se->expr = limit;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 1d4bef360e807d17255c92555f70355938d7ab24..387e690134b26206b72b47e44d6ff43efc3fdae7 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2006-02-25  Thomas Koenig  <Thomas.Koenig@online.de>
+
+       PR fortran/23092
+       * scalar_mask_1.f90:  New test.
+
 2006-02-24  Geoffrey Keating  <geoffk@apple.com>
 
        * g++.dg/eh/uncaught1.C: Add dg-options for ppc-darwin.

diff --git a/gcc/testsuite/gfortran.dg/scalar_mask_1.f90 b/gcc/testsuite/gfortran.dg/scalar_mask_1.f90
new file mode 100644 (file)
index 0000000..4f2a877
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/scalar_mask_1.f90
@@ -0,0 +1,13 @@
+! { dg-do run }
+program main
+  implicit none
+  real, dimension(2) :: a
+  a(1) = 2.0
+  a(2) = 3.0
+  if (product (a, .false.) /= 1.0) call abort
+  if (product (a, .true.) /= 6.0) call abort
+  if (sum (a, .false.) /= 0.0) call abort
+  if (sum (a, .true.) /= 5.0) call abort
+  if (maxval (a, .true.) /= 3.0) call abort
+  if (maxval (a, .false.) > -1e38) call abort
+end program main