From patchwork Sun Aug 26 18:12:54 2012 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Subject: [Fortran] Plug memory leaks; fix tree-check ICE for PR From: Tobias Burnus X-Patchwork-Id: 180075 Message-Id: <503A6726.9020404@net-b.de> To: gcc patches , gfortran Date: Sun, 26 Aug 2012 20:12:54 +0200 This patch fixes one ICE and several memory leaks. But there are more. ********************* The patch with symbol.c and resolve.c fixes the following issue: gfortran leaks memory for: REAL FUNCTION GGL(ds) GGL = 16806.D0 END The problem is the following code in resolve_symbol: /* Make sure the formal namespace is present. */ if (sym->formal && !sym->formal_ns) ... if (formal) { sym->formal_ns = formal->sym->ns; sym->formal_ns->refs++; } Thus, there are now two references to the same namespace. At the end, the memory is freed via gfc_symbol_done_2, which calls gfc_free_namespace (gfc_current_ns). In the latter, one has: ns->refs--; if (ns->refs > 0) return; free_sym_tree (ns->sym_root); and the latter frees the formal namespace. The problem is that "ns->ref == 2" won't get decreased. That's fixed by the first patch. * * * A similar issue existed for the CONTAINS leakage, which was mentioned the other day. Here, the problem is the increment in get_proc_name. However, a simple patch with the sym->refs++ in decl.c and symbol.c's special case for ENTRY wasn't sufficient as gfortran.dg/proc_ptr_result_1.f90 failed. I have now added some extra code to parse. to handle "ppr@". (If one uses valgrind on gfortran.dg/proc_ptr_result_1.f90 it leaks some gfc_symbol memory; however, the problems seem to be unrelated.) * * * gfortran didn't free gfc_common_head; I added a refs and free it now. (For blank commons, no special code is needed as ns->common_head is not a pointer.) * * * TODO: Despite my hopes for previous patch, there is at least one gfc_ss leak left (for channel.f90): ==12987== by 0xE6A7A8: xcalloc (xmalloc.c:162) ==12987== by 0x6074A3: gfc_get_array_ss(gfc_ss*, gfc_expr*, int, gfc_ss_type) (trans-array.c:561) ==12987== by 0x613870: gfc_walk_expr(gfc_expr*) (trans-array.c:8787) ==12987== by 0x63A908: gfc_trans_arrayfunc_assign(gfc_expr*, gfc_expr*) (trans-expr.c:6749) ==12987== by 0x63C281: gfc_trans_assignment(gfc_expr*, gfc_expr*, bool, bool) (trans-expr.c:7438) ==12987== by 0x602C31: trans_code(gfc_code*, tree_node*) (trans.c:1312) ==12987== by 0x65ED66: gfc_trans_do(gfc_code*, tree_node*) (trans-stmt.c:1395) TODO: There are some more failures, e.g. fatigue.f90 shows invalid reads ==13021== at 0x57C718: _ZL10show_locusP5locusii.isra.3 (error.c:392) ==13021== by 0x57CD55: error_print(char const*, char const*, __va_list_tag*) (error.c:661) ==13021== by 0x57D878: gfc_error(char const*, ...) (error.c:956) ==13021== by 0x5C3C16: match_complex_part(gfc_expr**) (primary.c:1205) ==13021== by 0x5C3DE6: gfc_match_literal_constant(gfc_expr**, int) (primary.c:1296) and memory leakage in ==13021== by 0xE6A7A8: xcalloc (xmalloc.c:162) ==13021== by 0x5F0077: gfc_new_symbol(char const*, gfc_namespace*) (symbol.c:2569) ==13021== by 0x5B5A75: read_module() (module.c:4698) ==13021== by 0x5B5E5B: gfc_use_module(gfc_use_list*) (module.c:6147) ==13021== by 0x5B7233: gfc_use_modules() (module.c:6270) ==13021== by 0x5BC147: use_modules() (parse.c:88) * * * * * * * * * * * * * * * The trans-stmt.c patch fixes a tree-check ICE as we mix different logical types; I decided to use the previous type instead folding to the boolean_type_node. Do you think it makes sense to backport it to 4.6/4.7? * * * Build and regtested on x86-64-linux. OK for the trunk? Tobias PS: I wonder why gfortran.dg/interface_3.f90 passed before, given that "proc_locus" wasn't set before. I also wonder why my patch causes the test case to segfault. Well, at least that bug is now also fixed. 2012-08-26 Tobias Burnus PR fortran/41093 * gfortran.h (gfc_common_head): Add "int refs". * match.c (gfc_match_common): Increment refs. * resolve.c (resolve_symbol): Only increment formal_ns->refs if formal_ns is not sym->ns. * symbol.c (gfc_free_symbol): Only free formal_ns if if formal_ns is not sym->ns. Free common_block if refs is one. (gfc_release_symbol): Release formal_ns only if the symbol is not ENTRY of a module. * decl.c (get_proc_name): Don't increment gfc_current_ns->refs. * parse.c (parse_interface): Incement proc_unit->refs++ for proc-pointer result variables. PR fortran/54370 * trans-stmt.c (gfc_trans_do_while): Don't change the logical kind for negation of the condition. 2012-08-26 Tobias Burnus PR fortran/54370 * gfortran.dg/do_5.f90: New. diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 87eb8a0..efd21dc 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -891,7 +891,6 @@ get_proc_name (const char *name, gfc_symbol **result, bool module_fcn_entry) return rc; sym = *result; - gfc_current_ns->refs++; if (sym && !sym->gfc_new && gfc_current_state () != COMP_INTERFACE) { diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 4c8a856..d67d57b 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1266,6 +1266,7 @@ typedef struct gfc_common_head struct gfc_symbol *head; const char* binding_label; int is_bind_c; + int refs; } gfc_common_head; diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index 0b1cf5a..4c713a5 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -4398,6 +4398,7 @@ gfc_match_common (void) /* Store a ref to the common block for error checking. */ sym->common_block = t; + sym->common_block->refs++; /* See if we know the current common block is bind(c), and if so, then see if we can check if the symbol is (which it'll diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index a4ff199..d13d816 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -3809,7 +3809,8 @@ mio_symbol (gfc_symbol *sym) if (sym->formal_ns) { sym->formal_ns->proc_name = sym; - sym->refs++; + if (sym->formal_ns != sym->ns) + sym->refs++; } } diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index c0ec6e4..5c5d381 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -2363,7 +2363,6 @@ parse_interface (void) gfc_interface_info save; gfc_state_data s1, s2; gfc_statement st; - locus proc_locus; accept_statement (ST_INTERFACE); @@ -2452,7 +2451,9 @@ loop: accept_statement (st); prog_unit = gfc_new_block; prog_unit->formal_ns = gfc_current_ns; - proc_locus = gfc_current_locus; + if (prog_unit == prog_unit->formal_ns->proc_name + && prog_unit->ns != prog_unit->formal_ns) + prog_unit->refs++; decl: /* Read data declaration statements. */ @@ -2493,7 +2494,8 @@ decl: && strcmp (current_interface.ns->proc_name->name, prog_unit->name) == 0) gfc_error ("INTERFACE procedure '%s' at %L has the same name as the " - "enclosing procedure", prog_unit->name, &proc_locus); + "enclosing procedure", prog_unit->name, + ¤t_interface.ns->proc_name->declared_at); goto loop; diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index c9be70e..63b730c 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -13086,7 +13086,8 @@ resolve_symbol (gfc_symbol *sym) if (formal) { sym->formal_ns = formal->sym->ns; - sym->formal_ns->refs++; + if (sym->ns != formal->sym->ns) + sym->formal_ns->refs++; } } diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 5a1e5ad..4d030b7 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -2511,7 +2511,8 @@ gfc_free_symbol (gfc_symbol *sym) gfc_free_namelist (sym->namelist); - gfc_free_namespace (sym->formal_ns); + if (sym->ns != sym->formal_ns) + gfc_free_namespace (sym->formal_ns); if (!sym->attr.generic_copy) gfc_free_interface (sym->generic); @@ -2520,6 +2521,13 @@ gfc_free_symbol (gfc_symbol *sym) gfc_free_namespace (sym->f2k_derived); + if (sym->common_block && sym->common_block->name[0] != '\0') + { + sym->common_block->refs--; + if (sym->common_block->refs == 0) + free (sym->common_block); + } + free (sym); } @@ -2532,7 +2540,8 @@ gfc_release_symbol (gfc_symbol *sym) if (sym == NULL) return; - if (sym->formal_ns != NULL && sym->refs == 2) + if (sym->formal_ns != NULL && sym->refs == 2 && sym->formal_ns != sym->ns + && (!sym->attr.entry || !sym->module)) { /* As formal_ns contains a reference to sym, delete formal_ns just before the deletion of sym. */ diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 9467601..8bc4916 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -1785,7 +1785,7 @@ gfc_trans_do_while (gfc_code * code) gfc_conv_expr_val (&cond, code->expr1); gfc_add_block_to_block (&block, &cond.pre); cond.expr = fold_build1_loc (code->expr1->where.lb->location, - TRUTH_NOT_EXPR, boolean_type_node, cond.expr); + TRUTH_NOT_EXPR, TREE_TYPE (cond.expr), cond.expr); /* Build "IF (! cond) GOTO exit_label". */ tmp = build1_v (GOTO_EXPR, exit_label); --- /dev/null 2012-08-26 08:23:10.319776146 +0200 +++ gcc/gcc/testsuite/gfortran.dg/do_5.f90 2012-08-26 16:34:15.000000000 +0200 @@ -0,0 +1,29 @@ +! { dg-do compile } +! +! PR fortran/54370 +! +! The following program was ICEing at tree-check time +! "L()" was regarded as default-kind logical. +! +! Contributed by Kirill Chilikin +! + MODULE M + CONTAINS + + LOGICAL(C_BOOL) FUNCTION L() BIND(C) + USE, INTRINSIC :: ISO_C_BINDING + L = .FALSE. + END FUNCTION + + LOGICAL(8) FUNCTION L2() BIND(C) + L2 = .FALSE._8 + END FUNCTION + + SUBROUTINE S() + DO WHILE (L()) + ENDDO + DO WHILE (L2()) + ENDDO + END + + END