===================================================================
@@ -4690,9 +4690,24 @@ gfc_check_vardef_context (gfc_expr* e, bool pointe
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)
{
===================================================================
@@ -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;
}
===================================================================
@@ -598,6 +598,24 @@ proc scan-module { args } {
}
}
+# Scan Fortran modules for absence of a given regexp.
+#
+# Argument 0 is the module name
+# Argument 1 is the regexp to match
+proc scan-module-absence { args } {
+ set modfilename [string tolower [lindex $args 0]].mod
+ set fd [open $modfilename r]
+ set text [read $fd]
+ close $fd
+
+ upvar 2 name testcase
+ if [regexp -- [lindex $args 1] $text] {
+ fail "$testcase scan-module [lindex $args 1]"
+ } else {
+ pass "$testcase scan-module [lindex $args 1]"
+ }
+}
+
# Verify that the compiler output file exists, invoked via dg-final.
proc output-exists { args } {
# Process an optional target or xfail list.
Hello world, the attached patch fixes PR 51502, where we wrongly recognized a procedure as implicit pure when we were assigning to a module variable within a block. This is a potential cause for wrong-code regressions (although no actual test case exists). For the test case, I had to scan for the absence of a string, which is why I introduced a new function for the testsuite. Regression-tested. OK for trunk and (after some time) for 4.6? Thomas 2011-12-29 Thomas König <tkoenig@gcc.gnu.org> 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 König <tkoenig@gcc.gnu.org> PR fortran/51502 * lib/gcc-dg.exp (scan-module-absence): New function. * gfortran.dg/implicit_pure_2.f90: New test. ! { 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" } }