[multiple changes]

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.

From-SVN: r141496
This commit is contained in:
Mikael Morin 2008-10-31 16:37:17 +01:00 committed by Mikael Morin
parent 798c19f855
commit 0e6834af18
4 changed files with 107 additions and 15 deletions

View File

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

View File

@ -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;
}
}

View File

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

View File

@ -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" } }