This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[patch, fortran] Fix PR 51502 - wrong implicit pure


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.
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.

Attachment: implicit_pure_2.f90
Description: Text document


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]