From 0e6834af18d539e4615be54eb2f9262898add8b4 Mon Sep 17 00:00:00 2001 From: Mikael Morin Date: Fri, 31 Oct 2008 16:37:17 +0100 Subject: [PATCH] [multiple changes] 2008-10-31 Mikael Morin 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 PR fortran/35820 * gfortran.dg/nested_forall_1.f: New test. From-SVN: r141496 --- gcc/fortran/ChangeLog | 8 +++ gcc/fortran/resolve.c | 71 ++++++++++++++++----- gcc/testsuite/ChangeLog | 5 ++ gcc/testsuite/gfortran.dg/nested_forall_1.f | 38 +++++++++++ 4 files changed, 107 insertions(+), 15 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/nested_forall_1.f diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 78373437459..1075d98025f 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2008-10-31 Mikael Morin + + 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 PR fortran/37930 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 1816907c3ec..3cd6899faae 100644 --- 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 e97b60fbf24..d0d12425f3c 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2008-10-16 Mikael Morin + + PR fortran/35820 + * gfortran.dg/nested_forall_1.f: New test. + 2008-10-30 Steven G. Kargl 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 index 00000000000..6aa66ee97a7 --- /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 + + 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" } } -- 2.30.2