===================================================================
@@ -407,6 +407,85 @@ cfe_code (gfc_code **c, int *walk_subtrees ATTRIBU
return 0;
}
+/* Dummy function for expression call back, for use when we
+ really don't want to do any walking. */
+
+static int
+dummy_expr_callback (gfc_expr **e ATTRIBUTE_UNUSED, int *walk_subtrees,
+ void *data ATTRIBUTE_UNUSED)
+{
+ *walk_subtrees = 0;
+ return 0;
+}
+
+/* Code callback function for converting
+ do while(a)
+ end do
+ into the equivalent
+ do
+ if (.not. a) exit
+ end do
+ This is because common function elimination would otherwise place the
+ temporary variables outside the loop. */
+
+static int
+convert_do_while (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED,
+ void *data ATTRIBUTE_UNUSED)
+{
+ gfc_code *co = *c;
+ gfc_code *c_if1, *c_if2, *c_exit;
+ gfc_code *loopblock;
+ gfc_expr *e_not, *e_cond;
+
+ if (co->op != EXEC_DO_WHILE)
+ return 0;
+
+ if (co->expr1 == NULL || co->expr1->expr_type == EXPR_CONSTANT)
+ return 0;
+
+ e_cond = co->expr1;
+
+ /* Generate the condition of the if statement, which is .not. the original
+ statement. */
+ e_not = gfc_get_expr ();
+ e_not->ts = e_cond->ts;
+ e_not->where = e_cond->where;
+ e_not->expr_type = EXPR_OP;
+ e_not->value.op.op = INTRINSIC_NOT;
+ e_not->value.op.op1 = e_cond;
+
+ /* Generate the EXIT statement. */
+ c_exit = XCNEW (gfc_code);
+ c_exit->op = EXEC_EXIT;
+ c_exit->ext.which_construct = co;
+ c_exit->loc = co->loc;
+
+ /* Generate the IF statement. */
+ c_if2 = XCNEW (gfc_code);
+ c_if2->op = EXEC_IF;
+ c_if2->expr1 = e_not;
+ c_if2->next = c_exit;
+ c_if2->loc = co->loc;
+
+ /* ... plus the one to chain it to. */
+ c_if1 = XCNEW (gfc_code);
+ c_if1->op = EXEC_IF;
+ c_if1->block = c_if2;
+ c_if1->loc = co->loc;
+
+ /* Make the DO WHILE loop into a DO block by replacing the condition
+ with a true constant. */
+ co->expr1 = gfc_get_logical_expr (gfc_default_integer_kind, &co->loc, true);
+
+ /* Hang the generated if statement into the loop body. */
+
+ loopblock = co->block->next;
+ co->block->next = c_if1;
+ c_if1->next = loopblock;
+
+ return 0;
+}
+
/* Optimize a namespace, including all contained namespaces. */
static void
@@ -415,6 +494,7 @@ optimize_namespace (gfc_namespace *ns)
current_ns = ns;
+ gfc_code_walker (&ns->code, convert_do_while, dummy_expr_callback, NULL);
gfc_code_walker (&ns->code, cfe_code, cfe_expr_0, NULL);
gfc_code_walker (&ns->code, optimize_code, optimize_expr, NULL);
Hello world, the attached patch fixes the PR by transforming DO WHILE (condition) ... END DO into the equvialent DO WHILE(.true.) IF (.not. condition) exit ... END DO before applying common function elimination. Otherwise, the temporary variables are created in the outer scope, and the condition never changes. Thanks to Tobias for finding the bug and forthe analysis in the PR. Regression-tested. OK for trunk? Thomas 2011-09-10 Thomas Koenig <tkoenig@gcc.gnu.org> PR fortran/50327 * frontend-passes.c (dummy_expr_callback): New function. (convert_do_while): New function. (optimize_namespace): Call code walker to convert do while loops. 2011-09-10 Thomas Koenig <tkoenig@gcc.gnu.org> PR fortran/50327 * gfortran.dg/do_while_1.f90: New test. ! { dg-do run } ! PR 50327 - this used to cause an endless loop because ! of wrong fron-end optimization. program main real :: tmp tmp = 0. do while (abs(tmp) < 10. .and. abs(tmp) < 20.) tmp = tmp + 1. end do end program main