Patchwork [fortran] Fix PR 51502 - wrong implicit pure

login
register
mail settings
Submitter Thomas Koenig
Date Dec. 29, 2011, 9:53 a.m.
Message ID <4EFC389C.3040704@netcologne.de>
Download mbox | patch
Permalink /patch/133535/
State New
Headers show

Comments

Thomas Koenig - Dec. 29, 2011, 9:53 a.m.
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" } }

Patch

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.