===================================================================
@@ -2110,18 +2110,41 @@ gfc_conv_power_op (gfc_se * se, gfc_expr * expr)
gfc_se lse;
gfc_se rse;
tree fndecl = NULL;
+ gfc_expr *op1, *op2;
+ op1 = expr->value.op.op1;
+ op2 = expr->value.op.op2;
+
gfc_init_se (&lse, se);
- gfc_conv_expr_val (&lse, expr->value.op.op1);
+ gfc_conv_expr_val (&lse, op1);
lse.expr = gfc_evaluate_now (lse.expr, &lse.pre);
gfc_add_block_to_block (&se->pre, &lse.pre);
gfc_init_se (&rse, se);
- gfc_conv_expr_val (&rse, expr->value.op.op2);
+ gfc_conv_expr_val (&rse, op2);
gfc_add_block_to_block (&se->pre, &rse.pre);
- if (expr->value.op.op2->ts.type == BT_INTEGER
- && expr->value.op.op2->expr_type == EXPR_CONSTANT)
+ if (op1->ts.type == BT_REAL && op1->expr_type == EXPR_CONSTANT
+ && op2->expr_type != EXPR_CONSTANT
+ && mpfr_cmp_si (op1->value.real, -1L) == 0)
+ {
+ tree tmp, type_op1, type_op2;
+
+ type_op1 = TREE_TYPE (lse.expr);
+ type_op2 = TREE_TYPE (rse.expr);
+
+ tmp = fold_build2_loc (input_location, BIT_AND_EXPR, type_op2,
+ rse.expr, build_int_cst (type_op2, 1));
+ tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
+ tmp, build_int_cst (type_op2, 0));
+ se->expr = fold_build3_loc (input_location, COND_EXPR, type_op1, tmp,
+ build_real (type_op1, dconst1),
+ build_real (type_op1, dconstm1));
+ return;
+ }
+
+ if (op2->ts.type == BT_INTEGER
+ && op2->expr_type == EXPR_CONSTANT)
if (gfc_conv_cst_int_power (se, lse.expr, rse.expr))
return;
@@ -2134,11 +2157,11 @@ gfc_conv_power_op (gfc_se * se, gfc_expr * expr)
res_ikind_1 = -1;
res_ikind_2 = -1;
- kind = expr->value.op.op1->ts.kind;
- switch (expr->value.op.op2->ts.type)
+ kind = op1->ts.kind;
+ switch (op2->ts.type)
{
case BT_INTEGER:
- ikind = expr->value.op.op2->ts.kind;
+ ikind = op2->ts.kind;
switch (ikind)
{
case 1:
@@ -2166,7 +2189,7 @@ gfc_conv_power_op (gfc_se * se, gfc_expr * expr)
{
case 1:
case 2:
- if (expr->value.op.op1->ts.type == BT_INTEGER)
+ if (op1->ts.type == BT_INTEGER)
{
lse.expr = convert (gfc_int4_type_node, lse.expr);
res_ikind_1 = kind;
@@ -2195,7 +2218,7 @@ gfc_conv_power_op (gfc_se * se, gfc_expr * expr)
gcc_unreachable ();
}
- switch (expr->value.op.op1->ts.type)
+ switch (op1->ts.type)
{
case BT_INTEGER:
if (kind == 3) /* Case 16 was not handled properly above. */
Hello world, the attached patch replaces (-1.0)**i with (in C language) (i & 1) == 0 ? 1.0 : 1.0, see PR 57073. I tried doing it in the middle end, see the PR of where these approaches failed. So, rather than not doing the optimization at all, I would rather do it in the Fortran front end. If somebody jumps in with a middle-end solution that works, I would withdraw this patch. Regression-tested on trunk. OK? Thomas 2013-05-19 Thomas Koenig <tkoenig@gcc.gnu.org> PR fortran/57073 * trans-expr.c: Simplify (-1.0)**i to (i & 1) == 0 ? 1.0 : -1.0. 2013-05-19 Thomas Koenig <tkoenig@gcc.gnu.org> PR fortran/57073 * gfortran.dg/power_6.f90: New test.