mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-04-10 12:21:09 +08:00
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:
parent
603518caa7
commit
3d2cea8c44
@ -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
|
||||
|
@ -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;
|
||||
}
|
||||
|
||||
|
||||
|
@ -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
|
||||
|
53
gcc/testsuite/gfortran.dg/implicit_pure_1.f90
Normal file
53
gcc/testsuite/gfortran.dg/implicit_pure_1.f90
Normal 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" } }
|
Loading…
x
Reference in New Issue
Block a user