Re: [Patch, Fortran] Fix PR 50564

[Thomas Koenig]

Hi Tobias,

In conclusion: I am fine with the FORALL part, but not with the
DO CONCURRENT part.

Yep, you're right.  I have modified the patch accordingly.  Here
is what I committed.

Best regards

        Thomas

Index: fortran/ChangeLog
===================================================================
--- fortran/ChangeLog	(revision 179768)
+++ fortran/ChangeLog	(working copy)
@@ -1,3 +1,12 @@
+2011-10-10  Thomas Koenig  <tkoe...@gcc.gnu.org>
+
+	PR fortran/50564
+	* frontend-passes (forall_level):  New variable.
+	(cfe_register_funcs):  Don't register functions if we
+	are within a forall loop.
+	(optimize_namespace):  Set forall_level to 0 before entry.
+	(gfc_code_walker):  Increase/decrease forall_level.
+
 2011-10-09  Tobias Burnus  <bur...@net-b.de>
 
 	PR fortran/45044
Index: fortran/frontend-passes.c
===================================================================
--- fortran/frontend-passes.c	(revision 179709)
+++ fortran/frontend-passes.c	(working copy)
@@ -62,6 +62,10 @@
 
 gfc_namespace *current_ns;
 
+/* If we are within any forall loop.  */
+
+static int forall_level;
+
 /* Entry point - run all passes for a namespace.  So far, only an
    optimization pass is run.  */
 
@@ -165,6 +169,12 @@
 	  || (*e)->ts.u.cl->length->expr_type != EXPR_CONSTANT))
     return 0;
 
+  /* We don't do function elimination within FORALL statements, it can
+     lead to wrong-code in certain circumstances.  */
+
+  if (forall_level > 0)
+    return 0;
+
   /* If we don't know the shape at compile time, we create an allocatable
      temporary variable to hold the intermediate result, but only if
      allocation on assignment is active.  */
@@ -493,6 +503,7 @@
 {
 
   current_ns = ns;
+  forall_level = 0;
 
   gfc_code_walker (&ns->code, convert_do_while, dummy_expr_callback, NULL);
   gfc_code_walker (&ns->code, cfe_code, cfe_expr_0, NULL);
@@ -1193,6 +1204,8 @@
 		    WALK_SUBEXPR (fa->end);
 		    WALK_SUBEXPR (fa->stride);
 		  }
+		if (co->op == EXEC_FORALL)
+		  forall_level ++;
 		break;
 	      }
 
@@ -1335,6 +1348,10 @@
 	      WALK_SUBEXPR (b->expr2);
 	      WALK_SUBCODE (b->next);
 	    }
+
+	  if (co->op == EXEC_FORALL)
+	    forall_level --;
+
 	}
     }
   return 0;