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 <[email protected]>
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 <[email protected]>
PR fortran/51502
* lib/gcc-dg.exp (scan-module-absence): New function.
* gfortran.dg/implicit_pure_2.f90: New test.
Index: fortran/expr.c
===================================================================
--- fortran/expr.c (Revision 182719)
+++ fortran/expr.c (Arbeitskopie)
@@ -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)
{
Index: fortran/resolve.c
===================================================================
--- fortran/resolve.c (Revision 182719)
+++ fortran/resolve.c (Arbeitskopie)
@@ -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;
}
Index: testsuite/lib/gcc-dg.exp
===================================================================
--- testsuite/lib/gcc-dg.exp (Revision 182430)
+++ testsuite/lib/gcc-dg.exp (Arbeitskopie)
@@ -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.
! { 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" } }
