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 <tkoe...@gcc.gnu.org> PR fortran/51858 * frontend-passes.c (convert_elseif): New function. (optimize_namespace): Call it. 2012-01-29 Thomas König <tkoe...@gcc.gnu.org> 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