[fortran] Fix PR 51858, wrong-code regression with function elimination

Submitted by Thomas Koenig on Jan. 29, 2012, 10:16 a.m.

Details

Message ID 4F251C70.7090802@netcologne.de
State New
Headers show

Commit Message

Thomas Koenig Jan. 29, 2012, 10:16 a.m.
Hello world,

the attached patch fixes the PR by converting

if (foo) then
...
else if (bar) then
...
end if

to if (foo) then
else
   if (bar) then
   end if
end if

so inserting a block for temporary variables around the converted
if statement works.

OK for trunk?

	Thomas

2012-01-29  Thomas König  <tkoenig@gcc.gnu.org>

         PR fortran/51858
         * frontend-passes.c (convert_elseif):  New function.
         (optimize_namespace):  Call it.

2012-01-29  Thomas König  <tkoenig@gcc.gnu.org>

         PR fortran/51858
         * gfortran.dg/function_optimize_10.f90:  New test.
! { do-do run }
! PR 51858 - this used to generate wrong code.
! Original test case by Don Simons.

program main
  implicit none
  logical :: test1_ok
  logical :: test2_ok
  character(len=1):: charq
  
  test1_ok = .true.
  test2_ok = .false.
  charq = 'c'
  if (charq .eq. ' ') then
     test1_ok = .false.
  else if ((my_ichar(charq).ge.97 .and. my_ichar(charq).le.103)) then
     test2_OK = .true.
  end if
  if ((.not. test1_ok) .or. (.not. test2_ok)) call abort
contains
  pure function my_ichar(c)
    integer :: my_ichar
    character(len=1), intent(in) :: c
    my_ichar = ichar(c)
  end function my_ichar
end program main

Comments

Thomas Koenig Jan. 29, 2012, 10:20 a.m.
I wrote:

> OK for trunk?

I forgot: Regression-tested.

	Thomas

Patch hide | download patch | download mbox

Index: frontend-passes.c
===================================================================
--- frontend-passes.c	(Revision 183449)
+++ frontend-passes.c	(Arbeitskopie)
@@ -509,6 +509,63 @@  convert_do_while (gfc_code **c, int *walk_subtrees
   return 0;
 }
 
+/* Code callback function for converting
+   if (a) then
+   ...
+   else if (b) then
+   end if
+
+   into
+   if (a) then
+   else
+     if (b) then
+     end if
+   end if
+
+   because otherwise common function elimination would place the BLOCKs
+   into the wrong place.  */
+
+static int
+convert_elseif (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED,
+		void *data ATTRIBUTE_UNUSED)
+{
+  gfc_code *co = *c;
+  gfc_code *c_if1, *c_if2, *else_stmt;
+
+  if (co->op != EXEC_IF)
+    return 0;
+
+  /* This loop starts out with the first ELSE statement.  */
+  for (else_stmt = co->block->block; else_stmt != NULL;
+       else_stmt = else_stmt->block)
+    {
+      /* If there is no condition, we're set.  */
+      if (else_stmt->expr1 == NULL)
+	break;
+
+      /* Generate the new IF statement.  */
+      c_if2 = XCNEW (gfc_code);
+      c_if2->op = EXEC_IF;
+      c_if2->expr1 = else_stmt->expr1;
+      c_if2->next = else_stmt->next;
+      c_if2->loc = else_stmt->loc;
+      c_if2->block = else_stmt->block;
+
+      /* ... 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 = else_stmt->loc;
+
+      /* Insert the new IF after the ELSE.  */
+      else_stmt->expr1 = NULL;
+      else_stmt->next = c_if1;
+      else_stmt->block = NULL;
+      else_stmt->next = c_if1;
+    }
+  /*  Don't walk subtrees.  */
+  return 1;
+}
 /* Optimize a namespace, including all contained namespaces.  */
 
 static void
@@ -520,6 +577,7 @@  optimize_namespace (gfc_namespace *ns)
   in_omp_workshare = false;
 
   gfc_code_walker (&ns->code, convert_do_while, dummy_expr_callback, NULL);
+  gfc_code_walker (&ns->code, convert_elseif, 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);