From: tkoenig Date: Wed, 1 Feb 2012 19:40:25 +0000 (+0000) Subject: 2012-02-01 Thomas König X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=ecce8d80d087429a803348721f03e5cf77f49412;p=thirdparty%2Fgcc.git 2012-02-01 Thomas König PR fortran/51958 * frontend-passes.c (convert_elseif): New function. (optimize_namespace): Call it. 2012-02-01 Thomas König 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 794101bcda4a..593d7784c629 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2012-02-01 Thomas König + + PR fortran/51958 + * frontend-passes.c (convert_elseif): New function. + (optimize_namespace): Call it. + 2012-02-01 Tobias Burnus PR fortran/52024 diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index 20f76ebfbe68..a86982fa3a70 100644 --- 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 6cf8868c0fbf..1b3a406e48ae 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2012-02-01 Thomas König + + PR fortran/51958 + * gfortran.dg/function_optimize_10.f90: New test. + 2012-02-01 Uros Bizjak * 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 index 000000000000..0be6b997ae10 --- /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 +