From: tkoenig Date: Sat, 25 Feb 2006 10:32:19 +0000 (+0000) Subject: 2006-02-25 Thomas Koenig X-Git-Url: http://git.sourceforge.jp/view?p=pf3gnuchains%2Fgcc-fork.git;a=commitdiff_plain;h=91b2f40f928a133632584b1622c4726cddb6b608 2006-02-25 Thomas Koenig 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 PR fortran/23092 * scalar_mask_1.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@111438 138bc75d-0d04-0410-961f-82ee72b054a4 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index c5e6bfa6564..b1172ba3fc9 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2006-02-25 Thomas Koenig + + 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 PR fortran/26409 diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 5b241a6a0fd..21477b126d4 100644 --- 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 1d4bef360e8..387e690134b 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2006-02-25 Thomas Koenig + + PR fortran/23092 + * scalar_mask_1.f90: New test. + 2006-02-24 Geoffrey Keating * 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 index 00000000000..4f2a877f3d5 --- /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