re PR fortran/51502 (Potentially wrong code generation due to wrong implict_pure check)

2011-12-31  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-31  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.

From-SVN: r182754

5 files changed, 65 insertions, 16 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index d79478d..c7ac160 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,13 @@
+2011-12-31  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 Koenig  <tkoenig@gcc.gnu.org>
 
 	* dependency.c (gfc_dep_compare_functions):  Document
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index d8ae04f..182738c 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 4bfdb79..0c27b23 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 3466234..aaba8c0 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2011-12-31  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.
+
 2011-12-30  Paolo Carlini  <paolo.carlini@oracle.com>
 
 	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 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" } }