diff options
| -rw-r--r-- | gcc/fortran/ChangeLog | 7 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 9 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/implicit_pure_1.f90 | 53 |
4 files changed, 71 insertions, 3 deletions
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 <burnus@net-b.de> + + 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 <burnus@net-b.de> 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 <burnus@net-b.de> + + PR fortran/51218 + * gfortran.dg/implicit_pure_1.f90: New. + 2011-11-24 Rainer Orth <ro@CeBiTec.Uni-Bielefeld.DE> 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" } } |