Patchwork [fortran] Fix PR 50327, regression in DO WHILE

login
register
mail settings
Submitter Thomas Koenig
Date Sept. 10, 2011, 9:23 a.m.
Message ID <4E6B2C8A.9090706@netcologne.de>
Download mbox | patch
Permalink /patch/114154/
State New
Headers show

Comments

Thomas Koenig - Sept. 10, 2011, 9:23 a.m.
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
Tobias Burnus - Sept. 11, 2011, 3:18 p.m.
Thomas Koenig wrote:
> 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.

Which matches what the current code in trans*.c already does (cf. dump 
in the PR).

> OK for trunk?

OK. Thanks for the patch!

Tobias

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

Patch

Index: frontend-passes.c
===================================================================
--- frontend-passes.c	(Revision 178139)
+++ frontend-passes.c	(Arbeitskopie)
@@ -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);