mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-03-20 09:20:42 +08:00
[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:
parent
798c19f855
commit
0e6834af18
@ -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
|
||||
|
@ -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;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
@ -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
|
||||
|
38
gcc/testsuite/gfortran.dg/nested_forall_1.f
Normal file
38
gcc/testsuite/gfortran.dg/nested_forall_1.f
Normal 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" } }
|
Loading…
x
Reference in New Issue
Block a user