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

login
register
mail settings
Submitter Thomas Koenig
Date Jan. 31, 2012, 11:07 p.m.
Message ID <4F287437.2090902@netcologne.de>
Download mbox | patch
Permalink /patch/138875/
State New
Headers show

Comments

Thomas Koenig - Jan. 31, 2012, 11:07 p.m.
Hi Tobias,

here is an updated version of the patch, with a more extensive test
case.  Also regression-tested.

OK for trunk?

	Thomas


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

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

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

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

program main
  implicit none
  logical :: test1_ok
  logical :: test2_ok
  logical :: test3_ok
  character(len=1):: charq

  charq = 'c'
  
  test1_ok = .true.
  test2_ok = .false.
  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

  test1_ok = .true.
  test2_ok = .true.
  test3_ok = .false.

  if (charq .eq. ' ') then
     test1_ok = .false.
  else if ((my_ichar(charq).lt.97 .or. my_ichar(charq).gt.103)) then
     test2_ok = .false.
  else if ((my_ichar(charq).ge.97 .and. my_ichar(charq).le.103)) then
     test3_ok = .true.
  end if
  if ((.not. test1_ok) .or. (.not. test2_ok) .or. (.not. test3_ok)) call abort

  test1_ok = .true.
  test2_ok = .true.
  test3_ok = .false.

  if (charq .eq. ' ') then
     test1_ok = .false.
  else if ((my_ichar(charq).lt.97 .or. my_ichar(charq).gt.103)) then
     test2_ok = .false.
  else
     test3_ok = .true.
  end if

  if ((.not. test1_ok) .or. (.not. test2_ok) .or. (.not. test3_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
Steve Kargl - Jan. 31, 2012, 11:32 p.m.
On Wed, Feb 01, 2012 at 12:07:35AM +0100, Thomas Koenig wrote:
> Hi Tobias,
> 
> here is an updated version of the patch, with a more extensive test
> case.  Also regression-tested.
> 
> OK for trunk?
> 

+      /* 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;

Is one of the else_stmt->next = c_if1; redundant?
Thomas Koenig - Jan. 31, 2012, 11:47 p.m.
Hi Steve,

> +      else_stmt->expr1 = NULL;
> +      else_stmt->next = c_if1;
> +      else_stmt->block = NULL;
> +      else_stmt->next = c_if1;
>
> Is one of the else_stmt->next = c_if1; redundant?
>

Definitely.  I'll take it out when I commit the patch.

	Thomas
Steve Kargl - Feb. 1, 2012, 1:09 a.m.
On Wed, Feb 01, 2012 at 12:47:28AM +0100, Thomas Koenig wrote:
> Hi Steve,
> 
> >+      else_stmt->expr1 = NULL;
> >+      else_stmt->next = c_if1;
> >+      else_stmt->block = NULL;
> >+      else_stmt->next = c_if1;
> >
> >Is one of the else_stmt->next = c_if1; redundant?
> >
> 
> Definitely.  I'll take it out when I commit the patch.
> 

Patch looks fine, then.  OK to commit.
Thomas Koenig - Feb. 1, 2012, 7:41 p.m.
Hi Steve,

> On Wed, Feb 01, 2012 at 12:47:28AM +0100, Thomas Koenig wrote:
>> Hi Steve,
>>
>>> +      else_stmt->expr1 = NULL;
>>> +      else_stmt->next = c_if1;
>>> +      else_stmt->block = NULL;
>>> +      else_stmt->next = c_if1;
>>>
>>> Is one of the else_stmt->next = c_if1; redundant?
>>>
>>
>> Definitely.  I'll take it out when I commit the patch.
>>
>
> Patch looks fine, then.  OK to commit.

Committed as rev. 183812, with one of the double lines taken out.

Thanks for the review!

	Thomas

Patch

Index: frontend-passes.c
===================================================================
--- frontend-passes.c	(Revision 183449)
+++ frontend-passes.c	(Arbeitskopie)
@@ -509,6 +509,70 @@  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.  */
+  else_stmt = co->block->block;
+
+  while (else_stmt != NULL)
+    {
+      gfc_code *next_else;
+
+      /* If there is no condition, we're done.  */
+      if (else_stmt->expr1 == NULL)
+	break;
+
+      next_else = else_stmt->block;
+
+      /* 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 = next_else;
+
+      /* ... 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;
+
+      else_stmt = next_else;
+    }
+  /*  Don't walk subtrees.  */
+  return 0;
+}
 /* Optimize a namespace, including all contained namespaces.  */
 
 static void
@@ -520,6 +584,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);