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

login
register
mail settings
Submitter Thomas Koenig
Date Jan. 29, 2012, 10:16 a.m.
Message ID <4F251C70.7090802@netcologne.de>
Download mbox | patch
Permalink /patch/138434/
State New
Headers show

Comments

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
Thomas Koenig - Jan. 29, 2012, 10:20 a.m.
I wrote:

> OK for trunk?

I forgot: Regression-tested.

	Thomas

Patch

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);