re PR fortran/51218 (Potential optimization bug due to implicit_pure?)

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-24  Tobias Burnus  <burnus@net-b.de>

        PR fortran/51218
        * gfortran.dg/implicit_pure_1.f90: New.

From-SVN: r181698
This commit is contained in:
Tobias Burnus 2011-11-24 18:57:41 +01:00 committed by Tobias Burnus
parent 603518caa7
commit 3d2cea8c44
4 changed files with 71 additions and 3 deletions

View File

@ -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

View File

@ -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;
}

View File

@ -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

View File

@ -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" } }