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 <[email protected]>
PR fortran/51858
* frontend-passes.c (convert_elseif): New function.
(optimize_namespace): Call it.
2012-01-29 Thomas König <[email protected]>
PR fortran/51858
* gfortran.dg/function_optimize_10.f90: New test.
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);
! { 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
