From d270ce529b4bdd51b952f8ed87746b9e77ada4c2 Mon Sep 17 00:00:00 2001 From: janus Date: Mon, 17 Aug 2009 09:11:00 +0000 Subject: [PATCH] 2009-08-17 Janus Weil PR fortran/40877 * array.c (gfc_resolve_character_array_constructor): Add NULL argument to gfc_new_charlen. * decl.c (add_init_expr_to_sym,variable_decl,match_char_spec, gfc_match_implicit): Ditto. * expr.c (simplify_const_ref): Fix memory leak. (gfc_simplify_expr): Add NULL argument to gfc_new_charlen. * gfortran.h (gfc_new_charlen): Modified prototype. * iresolve.c (check_charlen_present,gfc_resolve_char_achar): Add NULL argument to gfc_new_charlen. * module.c (mio_charlen): Ditto. * resolve.c (gfc_resolve_substring_charlen, gfc_resolve_character_operator,fixup_charlen): Ditto. (resolve_fl_derived,resolve_symbol): Add argument to gfc_charlen. * symbol.c (gfc_new_charlen): Add argument 'old_cl' (to make a copy of an existing charlen). (gfc_set_default_type,generate_isocbinding_symbol): Fix memory leak. (gfc_copy_formal_args_intr): Add NULL argument to gfc_new_charlen. * trans-decl.c (create_function_arglist): Fix memory leak. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@150823 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 22 ++++++++++++++++++++++ gcc/fortran/array.c | 2 +- gcc/fortran/decl.c | 12 ++++++------ gcc/fortran/expr.c | 13 ++++++------- gcc/fortran/gfortran.h | 2 +- gcc/fortran/iresolve.c | 4 ++-- gcc/fortran/module.c | 2 +- gcc/fortran/resolve.c | 14 +++++--------- gcc/fortran/symbol.c | 27 +++++++++++++++++++-------- gcc/fortran/trans-decl.c | 11 +---------- 10 files changed, 64 insertions(+), 45 deletions(-) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 694e02f89a9..8a63538bc23 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,25 @@ +2009-08-17 Janus Weil + + PR fortran/40877 + * array.c (gfc_resolve_character_array_constructor): Add NULL argument + to gfc_new_charlen. + * decl.c (add_init_expr_to_sym,variable_decl,match_char_spec, + gfc_match_implicit): Ditto. + * expr.c (simplify_const_ref): Fix memory leak. + (gfc_simplify_expr): Add NULL argument to gfc_new_charlen. + * gfortran.h (gfc_new_charlen): Modified prototype. + * iresolve.c (check_charlen_present,gfc_resolve_char_achar): Add NULL + argument to gfc_new_charlen. + * module.c (mio_charlen): Ditto. + * resolve.c (gfc_resolve_substring_charlen, + gfc_resolve_character_operator,fixup_charlen): Ditto. + (resolve_fl_derived,resolve_symbol): Add argument to gfc_charlen. + * symbol.c (gfc_new_charlen): Add argument 'old_cl' (to make a copy of + an existing charlen). + (gfc_set_default_type,generate_isocbinding_symbol): Fix memory leak. + (gfc_copy_formal_args_intr): Add NULL argument to gfc_new_charlen. + * trans-decl.c (create_function_arglist): Fix memory leak. + 2009-08-17 Richard Guenther * trans-expr.c (gfc_trans_scalar_assign): Replace hack with diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c index 2e12a146ae0..3ceb0e75181 100644 --- a/gcc/fortran/array.c +++ b/gcc/fortran/array.c @@ -1599,7 +1599,7 @@ gfc_resolve_character_array_constructor (gfc_expr *expr) goto got_charlen; } - expr->ts.u.cl = gfc_new_charlen (gfc_current_ns); + expr->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL); } got_charlen: diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index d5206a072da..e4813b80038 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -1265,7 +1265,7 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus) int clen; /* If there are multiple CHARACTER variables declared on the same line, we don't want them to share the same length. */ - sym->ts.u.cl = gfc_new_charlen (gfc_current_ns); + sym->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL); if (sym->attr.flavor == FL_PARAMETER) { @@ -1297,7 +1297,7 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus) { /* Build a new charlen to prevent simplification from deleting the length before it is resolved. */ - init->ts.u.cl = gfc_new_charlen (gfc_current_ns); + init->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL); init->ts.u.cl->length = gfc_copy_expr (sym->ts.u.cl->length); for (p = init->value.constructor; p; p = p->next) @@ -1601,7 +1601,7 @@ variable_decl (int elem) switch (match_char_length (&char_len)) { case MATCH_YES: - cl = gfc_new_charlen (gfc_current_ns); + cl = gfc_new_charlen (gfc_current_ns, NULL); cl->length = char_len; break; @@ -1613,7 +1613,7 @@ variable_decl (int elem) && (current_ts.u.cl->length == NULL || current_ts.u.cl->length->expr_type != EXPR_CONSTANT)) { - cl = gfc_new_charlen (gfc_current_ns); + cl = gfc_new_charlen (gfc_current_ns, NULL); cl->length = gfc_copy_expr (current_ts.u.cl->length); } else @@ -2235,7 +2235,7 @@ done: } /* Do some final massaging of the length values. */ - cl = gfc_new_charlen (gfc_current_ns); + cl = gfc_new_charlen (gfc_current_ns, NULL); if (seen_length == 0) cl->length = gfc_int_expr (1); @@ -2618,7 +2618,7 @@ gfc_match_implicit (void) if (ts.type == BT_CHARACTER && !ts.u.cl) { ts.kind = gfc_default_character_kind; - ts.u.cl = gfc_new_charlen (gfc_current_ns); + ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL); ts.u.cl->length = gfc_int_expr (1); } diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 85c0cea644c..57582a9fc47 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -1505,12 +1505,11 @@ simplify_const_ref (gfc_expr *p) string_len = 0; if (!p->ts.u.cl) - { - p->ts.u.cl = gfc_get_charlen (); - p->ts.u.cl->next = NULL; - p->ts.u.cl->length = NULL; - } - gfc_free_expr (p->ts.u.cl->length); + p->ts.u.cl = gfc_new_charlen (p->symtree->n.sym->ns, + NULL); + else + gfc_free_expr (p->ts.u.cl->length); + p->ts.u.cl->length = gfc_int_expr (string_len); } } @@ -1681,7 +1680,7 @@ gfc_simplify_expr (gfc_expr *p, int type) gfc_free (p->value.character.string); p->value.character.string = s; p->value.character.length = end - start; - p->ts.u.cl = gfc_new_charlen (gfc_current_ns); + p->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL); p->ts.u.cl->length = gfc_int_expr (p->value.character.length); gfc_free_ref_list (p->ref); p->ref = NULL; diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 17a0a532072..a4a3b817cf9 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -2436,7 +2436,7 @@ int gfc_symbols_could_alias (gfc_symbol *, gfc_symbol *); void gfc_undo_symbols (void); void gfc_commit_symbols (void); void gfc_commit_symbol (gfc_symbol *); -gfc_charlen *gfc_new_charlen (gfc_namespace *); +gfc_charlen *gfc_new_charlen (gfc_namespace *, gfc_charlen *); void gfc_free_charlen (gfc_charlen *, gfc_charlen *); void gfc_free_namespace (gfc_namespace *); diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c index 1c180eb27b8..ee8609e696b 100644 --- a/gcc/fortran/iresolve.c +++ b/gcc/fortran/iresolve.c @@ -63,7 +63,7 @@ static void check_charlen_present (gfc_expr *source) { if (source->ts.u.cl == NULL) - source->ts.u.cl = gfc_new_charlen (gfc_current_ns); + source->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL); if (source->expr_type == EXPR_CONSTANT) { @@ -161,7 +161,7 @@ gfc_resolve_char_achar (gfc_expr *f, gfc_expr *x, gfc_expr *kind, f->ts.type = BT_CHARACTER; f->ts.kind = (kind == NULL) ? gfc_default_character_kind : mpz_get_si (kind->value.integer); - f->ts.u.cl = gfc_new_charlen (gfc_current_ns); + f->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL); f->ts.u.cl->length = gfc_int_expr (1); f->value.function.name = gfc_get_string (name, f->ts.kind, diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index fe05dff8299..c791797d7dd 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -2009,7 +2009,7 @@ mio_charlen (gfc_charlen **clp) { if (peek_atom () != ATOM_RPAREN) { - cl = gfc_new_charlen (gfc_current_ns); + cl = gfc_new_charlen (gfc_current_ns, NULL); mio_expr (&cl->length); *clp = cl; } diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index ff32ae6e21d..fb72b938bee 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -4129,7 +4129,7 @@ gfc_resolve_substring_charlen (gfc_expr *e) e->ts.kind = gfc_default_character_kind; if (!e->ts.u.cl) - e->ts.u.cl = gfc_new_charlen (gfc_current_ns); + e->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL); if (char_ref->u.ss.start) start = gfc_copy_expr (char_ref->u.ss.start); @@ -4602,7 +4602,7 @@ gfc_resolve_character_operator (gfc_expr *e) else if (op2->expr_type == EXPR_CONSTANT) e2 = gfc_int_expr (op2->value.character.length); - e->ts.u.cl = gfc_new_charlen (gfc_current_ns); + e->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL); if (!e1 || !e2) return; @@ -4641,7 +4641,7 @@ fixup_charlen (gfc_expr *e) default: if (!e->ts.u.cl) - e->ts.u.cl = gfc_new_charlen (gfc_current_ns); + e->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL); break; } @@ -9452,9 +9452,7 @@ resolve_fl_derived (gfc_symbol *sym) /* Copy char length. */ if (ifc->ts.type == BT_CHARACTER && ifc->ts.u.cl) { - c->ts.u.cl = gfc_new_charlen (sym->ns); - c->ts.u.cl->resolved = ifc->ts.u.cl->resolved; - c->ts.u.cl->length = gfc_copy_expr (ifc->ts.u.cl->length); + c->ts.u.cl = gfc_new_charlen (sym->ns, ifc->ts.u.cl); /* TODO: gfc_expr_replace_symbols (c->ts.u.cl->length, c);*/ } } @@ -9956,9 +9954,7 @@ resolve_symbol (gfc_symbol *sym) /* Copy char length. */ if (ifc->ts.type == BT_CHARACTER && ifc->ts.u.cl) { - sym->ts.u.cl = gfc_new_charlen (sym->ns); - sym->ts.u.cl->resolved = ifc->ts.u.cl->resolved; - sym->ts.u.cl->length = gfc_copy_expr (ifc->ts.u.cl->length); + sym->ts.u.cl = gfc_new_charlen (sym->ns, ifc->ts.u.cl); gfc_expr_replace_symbols (sym->ts.u.cl->length, sym); } } diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index dc10bc69e48..8e4f6e9a114 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -270,10 +270,7 @@ gfc_set_default_type (gfc_symbol *sym, int error_flag, gfc_namespace *ns) sym->attr.implicit_type = 1; if (ts->type == BT_CHARACTER && ts->u.cl) - { - sym->ts.u.cl = gfc_get_charlen (); - *sym->ts.u.cl = *ts->u.cl; - } + sym->ts.u.cl = gfc_new_charlen (sym->ns, ts->u.cl); if (sym->attr.is_bind_c == 1) { @@ -3076,15 +3073,29 @@ gfc_free_finalizer_list (gfc_finalizer* list) } -/* Create a new gfc_charlen structure and add it to a namespace. */ +/* Create a new gfc_charlen structure and add it to a namespace. + If 'old_cl' is given, the newly created charlen will be a copy of it. */ gfc_charlen* -gfc_new_charlen (gfc_namespace *ns) +gfc_new_charlen (gfc_namespace *ns, gfc_charlen *old_cl) { gfc_charlen *cl; cl = gfc_get_charlen (); + + /* Put into namespace. */ cl->next = ns->cl_list; ns->cl_list = cl; + + /* Copy old_cl. */ + if (old_cl) + { + cl->length = gfc_copy_expr (old_cl->length); + cl->length_from_typespec = old_cl->length_from_typespec; + cl->backend_decl = old_cl->backend_decl; + cl->passed_length = old_cl->passed_length; + cl->resolved = old_cl->resolved; + } + return cl; } @@ -3956,7 +3967,7 @@ gfc_copy_formal_args_intr (gfc_symbol *dest, gfc_intrinsic_sym *src) formal_arg->sym->attr.dummy = 1; if (formal_arg->sym->ts.type == BT_CHARACTER) - formal_arg->sym->ts.u.cl = gfc_new_charlen (gfc_current_ns); + formal_arg->sym->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL); /* If this isn't the first arg, set up the next ptr. For the last arg built, the formal_arg->next will never get set to @@ -4219,7 +4230,7 @@ generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s, tmp_sym->value->value.character.string[0] = (gfc_char_t) c_interop_kinds_table[s].value; tmp_sym->value->value.character.string[1] = '\0'; - tmp_sym->ts.u.cl = gfc_get_charlen (); + tmp_sym->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL); tmp_sym->ts.u.cl->length = gfc_int_expr (1); /* May not need this in both attr and ts, but do need in diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index ceabbbe0b98..3cc790381ae 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -1796,16 +1796,7 @@ create_function_arglist (gfc_symbol * sym) /* This can happen if the same type is used for multiple arguments. We need to copy cl as otherwise cl->passed_length gets overwritten. */ - gfc_charlen *cl, *cl2; - cl = f->sym->ts.u.cl; - f->sym->ts.u.cl = gfc_get_charlen(); - f->sym->ts.u.cl->length = cl->length; - f->sym->ts.u.cl->backend_decl = cl->backend_decl; - f->sym->ts.u.cl->length_from_typespec = cl->length_from_typespec; - f->sym->ts.u.cl->resolved = cl->resolved; - cl2 = f->sym->ts.u.cl->next; - f->sym->ts.u.cl->next = cl; - cl->next = cl2; + f->sym->ts.u.cl = gfc_new_charlen (f->sym->ns, f->sym->ts.u.cl); } f->sym->ts.u.cl->passed_length = length; -- 2.11.0