From 3d2cea8c44f8e1e428edb6f17fe12c69301c8fe1 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Thu, 24 Nov 2011 18:57:41 +0100 Subject: re PR fortran/51218 (Potential optimization bug due to implicit_pure?) 2011-11-24 Tobias Burnus PR fortran/51218 * resolve.c (pure_subroutine): If called subroutine is impure, unset implicit_pure. (resolve_function): Move impure check to simplify code. 2011-11-24 Tobias Burnus PR fortran/51218 * gfortran.dg/implicit_pure_1.f90: New. From-SVN: r181698 --- gcc/fortran/ChangeLog | 7 ++++ gcc/fortran/resolve.c | 9 +++-- gcc/testsuite/ChangeLog | 5 +++ gcc/testsuite/gfortran.dg/implicit_pure_1.f90 | 53 +++++++++++++++++++++++++++ 4 files changed, 71 insertions(+), 3 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/implicit_pure_1.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 83974b5..1831842 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2011-11-24 Tobias Burnus + + PR fortran/51218 + * resolve.c (pure_subroutine): If called subroutine is + impure, unset implicit_pure. + (resolve_function): Move impure check to simplify code. + 2011-11-19 Tobias Burnus PR fortran/51207 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 94c21be..6baeff44 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -3191,10 +3191,10 @@ resolve_function (gfc_expr *expr) "procedure within a PURE procedure", name, &expr->where); t = FAILURE; } - } - if (!pure_function (expr, &name) && name && gfc_implicit_pure (NULL)) - gfc_current_ns->proc_name->attr.implicit_pure = 0; + if (gfc_implicit_pure (NULL)) + gfc_current_ns->proc_name->attr.implicit_pure = 0; + } /* Functions without the RECURSIVE attribution are not allowed to * call themselves. */ @@ -3257,6 +3257,9 @@ pure_subroutine (gfc_code *c, gfc_symbol *sym) else if (gfc_pure (NULL)) gfc_error ("Subroutine call to '%s' at %L is not PURE", sym->name, &c->loc); + + if (gfc_implicit_pure (NULL)) + gfc_current_ns->proc_name->attr.implicit_pure = 0; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 32a6884..d56b2b7 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2011-11-24 Tobias Burnus + + PR fortran/51218 + * gfortran.dg/implicit_pure_1.f90: New. + 2011-11-24 Rainer Orth PR testsuite/51258 diff --git a/gcc/testsuite/gfortran.dg/implicit_pure_1.f90 b/gcc/testsuite/gfortran.dg/implicit_pure_1.f90 new file mode 100644 index 0000000..d4a5a36 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/implicit_pure_1.f90 @@ -0,0 +1,53 @@ +! { dg-do run } +! +! PR fortran/51218 +! +! Contributed by Harald Anlauf +! + +module a + implicit none + integer :: neval = 0 +contains + subroutine inc_eval + neval = neval + 1 + end subroutine inc_eval +end module a + +module b + use a + implicit none +contains + function f(x) ! Should be implicit pure + real :: f + real, intent(in) :: x + f = x + end function f + + function g(x) ! Should NOT be implicit pure + real :: g + real, intent(in) :: x + call inc_eval + g = x + end function g +end module b + +program gfcbug114a + use a + use b + implicit none + real :: x = 1, y = 1, t, u, v, w + if (neval /= 0) call abort () + t = f(x)*f(y) + if (neval /= 0) call abort () + u = f(x)*f(y) + f(x)*f(y) + if (neval /= 0) call abort () + v = g(x)*g(y) + if (neval /= 2) call abort () + w = g(x)*g(y) + g(x)*g(y) + if (neval /= 6) call abort () + if (t /= 1.0 .or. u /= 2.0 .or. v /= 1.0 .or. w /= 2) call abort () +end program gfcbug114a + +! { dg-final { scan-module "b" "IMPLICIT_PURE" } } +! { dg-final { cleanup-modules "b" } } -- cgit v1.1