backport: re PR fortran/51502 (Potentially wrong code generation due to wrong implict...

2012-01-01  Thomas König  <tkoenig@gcc.gnu.org>

	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  <tkoenig@gcc.gnu.org>

	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 503c9bb9ad2ba8182787628a8a624be36066eadb..9a2d3fcda5a45eb67981b0efe7e967dc0622890b 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,14 @@
+2012-01-01  Thomas König  <tkoenig@gcc.gnu.org>
+
+       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  <toon@moene.org>
 
        PR fortran/51310

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 96aea8d6b83f4b2177e79bc3a6ace761ac813c56..d5784c5d395e69084419fb939f7b80ef6534855d 100644 (file)
--- 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 8d1ef0f1af8d0646bec30a149f5f5bd348e9ba2e..84753b2429772521f2f9c32d4181972ea6d529ab 100644 (file)
--- 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 3bef6a78fc18d4e3bdd81a8ae190305a430ec61d..2ce065e8003f75a595f815de43541be606c27ccb 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+2012-01-01  Thomas König  <tkoenig@gcc.gnu.org>
+
+       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  <meissner@linux.vnet.ibm.com>
 
        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 (file)
index 0000000..496e856
--- /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 4cdfa3e0251f65accfe0a0fa20f6ed05e2a22c5d..450f27804ea5bafcf7092a28aa5ae2dc3aa07b9c 100644 (file)
--- 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.