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

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

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

	PR fortran/51958
	* gfortran.dg/function_optimize_10.f90:  New test.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@183812 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 794101bcda4a1c992ff6cd1b8e329a1aa34ca7a6..593d7784c629c700f93752bb4a68894643b4bf5f 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2012-02-01  Thomas König  <tkoenig@gcc.gnu.org>
+
+       PR fortran/51958
+       * frontend-passes.c (convert_elseif):  New function.
+       (optimize_namespace):  Call it.
+
 2012-02-01  Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/52024

diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c
index 20f76ebfbe683998d9654486aee18155a73d02a1..a86982fa3a702320b8991dd2991c8f331f637d8a 100644 (file)
--- a/gcc/fortran/frontend-passes.c
+++ b/gcc/fortran/frontend-passes.c
@@ -510,6 +510,69 @@ convert_do_while (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED,
   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_else;
+    }
+  /*  Don't walk subtrees.  */
+  return 0;
+}
 /* Optimize a namespace, including all contained namespaces.  */
 
 static void
@@ -521,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);
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 6cf8868c0fbfa3110d5df16436429f3a753e5418..1b3a406e48ae38438d73895a8bf0826441736e46 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2012-02-01  Thomas König  <tkoenig@gcc.gnu.org>
+
+       PR fortran/51958
+       * gfortran.dg/function_optimize_10.f90:  New test.
+
 2012-02-01  Uros Bizjak  <ubizjak@gmail.com>
 
        * go.test/go-test.exp (go-gc-tests): xfail test/nilptr.go runtime

diff --git a/gcc/testsuite/gfortran.dg/function_optimize_10.f90 b/gcc/testsuite/gfortran.dg/function_optimize_10.f90
new file mode 100644 (file)
index 0000000..0be6b99
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/function_optimize_10.f90
@@ -0,0 +1,57 @@
+! { 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
+  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
+