2008-10-31 Mikael Morin <mikael.morin@tele2.fr>

	PR fortran/35820
	* resolve.c (gfc_count_forall_iterators): New function.
	(gfc_resolve_forall): Use gfc_count_forall_iterators to evaluate
	the needed memory amount to allocate. Don't forget to free allocated
	memory.  Add an assertion to check for memory leaks.

2008-10-16  Mikael Morin  <mikael.morin@tele2.fr>

	PR fortran/35820
	* gfortran.dg/nested_forall_1.f: New test.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@141496 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 7837343..1075d98 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2008-10-31  Mikael Morin  <mikael.morin@tele2.fr>
+
+       PR fortran/35820
+       * resolve.c (gfc_count_forall_iterators): New function.
+       (gfc_resolve_forall): Use gfc_count_forall_iterators to evaluate 
+       the needed memory amount to allocate. Don't forget to free allocated 
+       memory.  Add an assertion to check for memory leaks. 
+
 2008-10-30  Steven G. Kargl  <kargls@comcast.net>
 
        PR fortran/37930

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 1816907..3cd6899 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -6215,6 +6215,40 @@ gfc_resolve_forall_body (gfc_code *code, int nvar, gfc_expr **var_expr)
 }
 
 
+/* Counts the number of iterators needed inside a forall construct, including
+   nested forall constructs. This is used to allocate the needed memory 
+   in gfc_resolve_forall.  */
+
+static int 
+gfc_count_forall_iterators (gfc_code *code)
+{
+  int max_iters, sub_iters, current_iters;
+  gfc_forall_iterator *fa;
+
+  gcc_assert(code->op == EXEC_FORALL);
+  max_iters = 0;
+  current_iters = 0;
+
+  for (fa = code->ext.forall_iterator; fa; fa = fa->next)
+    current_iters ++;
+  
+  code = code->block->next;
+
+  while (code)
+    {          
+      if (code->op == EXEC_FORALL)
+        {
+          sub_iters = gfc_count_forall_iterators (code);
+          if (sub_iters > max_iters)
+            max_iters = sub_iters;
+        }
+      code = code->next;
+    }
+
+  return current_iters + max_iters;
+}
+
+
 /* Given a FORALL construct, first resolve the FORALL iterator, then call
    gfc_resolve_forall_body to resolve the FORALL body.  */
 
@@ -6224,22 +6258,18 @@ gfc_resolve_forall (gfc_code *code, gfc_namespace *ns, int forall_save)
   static gfc_expr **var_expr;
   static int total_var = 0;
   static int nvar = 0;
+  int old_nvar, tmp;
   gfc_forall_iterator *fa;
-  gfc_code *next;
   int i;
 
+  old_nvar = nvar;
+
   /* Start to resolve a FORALL construct   */
   if (forall_save == 0)
     {
       /* Count the total number of FORALL index in the nested FORALL
-        construct in order to allocate the VAR_EXPR with proper size.  */
-      next = code;
-      while ((next != NULL) && (next->op == EXEC_FORALL))
-       {
-         for (fa = next->ext.forall_iterator; fa; fa = fa->next)
-           total_var ++;
-         next = next->block->next;
-       }
+         construct in order to allocate the VAR_EXPR with proper size.  */
+      total_var = gfc_count_forall_iterators (code);
 
       /* Allocate VAR_EXPR with NUMBER_OF_FORALL_INDEX elements.  */
       var_expr = (gfc_expr **) gfc_getmem (total_var * sizeof (gfc_expr *));
@@ -6264,6 +6294,9 @@ gfc_resolve_forall (gfc_code *code, gfc_namespace *ns, int forall_save)
       var_expr[nvar] = gfc_copy_expr (fa->var);
 
       nvar++;
+
+      /* No memory leak.  */
+      gcc_assert (nvar <= total_var);
     }
 
   /* Resolve the FORALL body.  */
@@ -6272,13 +6305,21 @@ gfc_resolve_forall (gfc_code *code, gfc_namespace *ns, int forall_save)
   /* May call gfc_resolve_forall to resolve the inner FORALL loop.  */
   gfc_resolve_blocks (code->block, ns);
 
-  /* Free VAR_EXPR after the whole FORALL construct resolved.  */
-  for (i = 0; i < total_var; i++)
-    gfc_free_expr (var_expr[i]);
+  tmp = nvar;
+  nvar = old_nvar;
+  /* Free only the VAR_EXPRs allocated in this frame.  */
+  for (i = nvar; i < tmp; i++)
+     gfc_free_expr (var_expr[i]);
 
-  /* Reset the counters.  */
-  total_var = 0;
-  nvar = 0;
+  if (nvar == 0)
+    {
+      /* We are in the outermost FORALL construct.  */
+      gcc_assert (forall_save == 0);
+
+      /* VAR_EXPR is not needed any more.  */
+      gfc_free (var_expr);
+      total_var = 0;
+    }
 }
 
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index e97b60f..d0d1242 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2008-10-16  Mikael Morin  <mikael.morin@tele2.fr>
+
+       PR fortran/35820
+       * gfortran.dg/nested_forall_1.f: New test.
+
 2008-10-30  Steven G. Kargl  <kargls@comcast.net>
 
        PR fortran/37930

diff --git a/gcc/testsuite/gfortran.dg/nested_forall_1.f b/gcc/testsuite/gfortran.dg/nested_forall_1.f
new file mode 100644 (file)
index 0000000..6aa66ee
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/nested_forall_1.f
@@ -0,0 +1,38 @@
+! { dg-do compile }
+!
+! PR fortran/35820
+! 
+! Memory leak(s) while resolving forall constructs.
+! 
+! Contributed by Dick Hendrickson <dick.hendrickson@gmail.com>
+
+      MODULE TESTS
+      INTEGER,PARAMETER,PUBLIC  ::  I1_KV = KIND(1)
+      INTEGER,PARAMETER,PUBLIC  ::  R1_KV = KIND(1.0)
+      INTEGER, PRIVATE :: J1,J2
+      INTEGER,PARAMETER,PUBLIC  ::  S1 = 10, S2 = 9
+      CONTAINS
+      SUBROUTINE SA0136(RDA,IDA,BDA)
+      REAL(R1_KV) RDA(S1)
+      INTEGER(I1_KV) IDA(S1,S2)
+      INTEGER(I1_KV) ICA(S1,S2)
+      REAL(R1_KV) RCA(S1)
+!  T E S T  S T A T E M E N T S
+      FORALL (J1 = 1:S1)
+        RDA(J1) = RCA(J1) + 1.0_R1_KV
+        FORALL (J2 = 1:S2)
+          IDA(J1,J2) = ICA(J1,J2) + 1
+        END FORALL
+        FORALL (J2 = 1:S2)
+          IDA(J1,J2) = ICA(J1,J2)
+        END FORALL
+      ENDFORALL
+      FORALL (J1 = 1:S1)
+        RDA(J1) = RCA(J1)
+        FORALL (J2 = 1:S2)
+          IDA(J1,J2) = ICA(J1,J2)
+        END FORALL
+      END FORALL
+      END SUBROUTINE
+      END MODULE TESTS
+! { dg-final { cleanup-modules "tests" } }