From: Thomas Koenig Date: Sun, 1 Jan 2012 16:12:39 +0000 (+0000) Subject: backport: re PR fortran/51502 (Potentially wrong code generation due to wrong implict... X-Git-Tag: releases/gcc-4.6.3~216 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=9d4d5a51488ac225b7c499c14d7c9666f944a62d;p=thirdparty%2Fgcc.git backport: re PR fortran/51502 (Potentially wrong code generation due to wrong implict_pure check) 2012-01-01 Thomas König Backport from trunk 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. 2012-01-01 Thomas König Backport from trunk PR fortran/51502 * lib/gcc-dg.exp (scan-module-absence): New function. * gfortran.dg/implicit_pure_2.f90: New test. From-SVN: r182770 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 503c9bb9ad2b..9a2d3fcda5a4 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,14 @@ +2012-01-01 Thomas König + + Backport from trunk + 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-22 Toon Moene PR fortran/51310 diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 96aea8d6b83f..d5784c5d395e 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -4523,9 +4523,24 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, const char* context) 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 8d1ef0f1af8d..84753b242977 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -12936,24 +12936,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 3bef6a78fc18..2ce065e8003f 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2012-01-01 Thomas König + + Backport from trunk + PR fortran/51502 + * lib/gcc-dg.exp (scan-module-absence): New function. + * gfortran.dg/implicit_pure_2.f90: New test. + 2011-12-28 Michael Meissner Backport from mainline 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 000000000000..496e856e04ac --- /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" } } diff --git a/gcc/testsuite/lib/gcc-dg.exp b/gcc/testsuite/lib/gcc-dg.exp index 4cdfa3e0251f..450f27804ea5 100644 --- a/gcc/testsuite/lib/gcc-dg.exp +++ b/gcc/testsuite/lib/gcc-dg.exp @@ -565,6 +565,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.