diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index d79478d949c..c7ac160386c 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,13 @@ +2011-12-31 Thomas König + + PR fortran/51502 + * expr.c (gfc_check_vardef_context): When determining + implicit pure status, also check for variable definition + context. Walk up namespaces until a procedure is + found to reset the implict pure attribute. + * resolve.c (gfc_implicit_pure): Walk up namespaces + until a procedure is found. + 2011-12-29 Thomas Koenig * dependency.c (gfc_dep_compare_functions): Document diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index d8ae04f0494..182738cbf3d 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -4690,9 +4690,24 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj, return FAILURE; } - if (!pointer && gfc_implicit_pure (NULL) && gfc_impure_variable (sym)) - gfc_current_ns->proc_name->attr.implicit_pure = 0; + if (!pointer && context && gfc_implicit_pure (NULL) + && gfc_impure_variable (sym)) + { + gfc_namespace *ns; + gfc_symbol *sym; + for (ns = gfc_current_ns; ns; ns = ns->parent) + { + sym = ns->proc_name; + if (sym == NULL) + break; + if (sym->attr.flavor == FL_PROCEDURE) + { + sym->attr.implicit_pure = 0; + break; + } + } + } /* Check variable definition context for associate-names. */ if (!pointer && sym->assoc) { diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 4bfdb7987bf..0c27b2360b0 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -13103,24 +13103,25 @@ gfc_pure (gfc_symbol *sym) int gfc_implicit_pure (gfc_symbol *sym) { - symbol_attribute attr; + gfc_namespace *ns; if (sym == NULL) { - /* Check if the current namespace is implicit_pure. */ - sym = gfc_current_ns->proc_name; - if (sym == NULL) - return 0; - attr = sym->attr; - if (attr.flavor == FL_PROCEDURE - && attr.implicit_pure && !attr.pure) - return 1; - return 0; + /* Check if the current procedure is implicit_pure. Walk up + the procedure list until we find a procedure. */ + for (ns = gfc_current_ns; ns; ns = ns->parent) + { + sym = ns->proc_name; + if (sym == NULL) + return 0; + + if (sym->attr.flavor == FL_PROCEDURE) + break; + } } - - attr = sym->attr; - - return attr.flavor == FL_PROCEDURE && attr.implicit_pure && !attr.pure; + + return sym->attr.flavor == FL_PROCEDURE && sym->attr.implicit_pure + && !sym->attr.pure; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 34662342a8f..aaba8c0de5c 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2011-12-31 Thomas König + + PR fortran/51502 + * lib/gcc-dg.exp (scan-module-absence): New function. + * gfortran.dg/implicit_pure_2.f90: New test. + 2011-12-30 Paolo Carlini PR c++/51316 diff --git a/gcc/testsuite/gfortran.dg/implicit_pure_2.f90 b/gcc/testsuite/gfortran.dg/implicit_pure_2.f90 new file mode 100644 index 00000000000..496e856e04a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/implicit_pure_2.f90 @@ -0,0 +1,17 @@ +! { dg-do compile } +! PR 51502 - this was wrongly detected to be implicit pure. +module m + integer :: i +contains + subroutine foo(x) + integer, intent(inout) :: x + outer: block + block + i = 5 + end block + end block outer + end subroutine foo +end module m + +! { dg-final { scan-module-absence "m" "IMPLICIT_PURE" } } +! { dg-final { cleanup-modules "m" } }