procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
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
This commit is contained in:
Thomas Koenig 2006-02-25 10:32:19 +00:00 • committed by Thomas Koenig
parent a487672562
commit eaf618e3a9
4 changed files with 69 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
gcc/fortran/ChangeLog
View file

@ -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

49
gcc/fortran/trans-intrinsic.c
View file

@ -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;

5
gcc/testsuite/ChangeLog
View file

@ -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.

13
gcc/testsuite/gfortran.dg/scalar_mask_1.f90 Normal file
View file

@ -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