From bfce226c16841059130f0dff32da251a6999fa16 Mon Sep 17 00:00:00 2001 From: Janus Weil Date: Fri, 24 Jul 2009 13:00:01 +0200 Subject: [PATCH] re PR fortran/40822 (Internal compiler error when Fortran intrinsic LEN referenced before explicit declaration) 2009-07-24 Janus Weil PR fortran/40822 * array.c (gfc_resolve_character_array_constructor): Use new function gfc_new_charlen. * decl.c (add_init_expr_to_sym,variable_decl,match_char_spec, gfc_match_implicit): Ditto. * expr.c (gfc_simplify_expr): Ditto. * gfortran.h (gfc_new_charlen): New prototype. * iresolve.c (check_charlen_present,gfc_resolve_char_achar): Use new function gfc_new_charlen. * module.c (mio_charlen): Ditto. * resolve.c (gfc_resolve_substring_charlen, gfc_resolve_character_operator,fixup_charlen,resolve_fl_derived, resolve_symbol): Ditto. * symbol.c (gfc_new_charlen): New function to create a new gfc_charlen structure and add it to a namespace. (gfc_copy_formal_args_intr): Make sure ts.cl is present for CHARACTER variables. 2009-07-24 Janus Weil PR fortran/40822 * gfortran.dg/char_length_16.f90: New. From-SVN: r150047 --- gcc/fortran/ChangeLog | 20 +++++++++++++++++ gcc/fortran/array.c | 4 +--- gcc/fortran/decl.c | 24 ++++++--------------- gcc/fortran/expr.c | 4 +--- gcc/fortran/gfortran.h | 1 + gcc/fortran/iresolve.c | 10 ++------- gcc/fortran/module.c | 6 +----- gcc/fortran/resolve.c | 32 +++++----------------------- gcc/fortran/symbol.c | 16 ++++++++++++++ gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gfortran.dg/char_length_16.f90 | 12 +++++++++++ 11 files changed, 70 insertions(+), 64 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/char_length_16.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 580a0b2..5f6cf27 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,23 @@ +2009-07-24 Janus Weil + + PR fortran/40822 + * array.c (gfc_resolve_character_array_constructor): Use new function + gfc_new_charlen. + * decl.c (add_init_expr_to_sym,variable_decl,match_char_spec, + gfc_match_implicit): Ditto. + * expr.c (gfc_simplify_expr): Ditto. + * gfortran.h (gfc_new_charlen): New prototype. + * iresolve.c (check_charlen_present,gfc_resolve_char_achar): Use new + function gfc_new_charlen. + * module.c (mio_charlen): Ditto. + * resolve.c (gfc_resolve_substring_charlen, + gfc_resolve_character_operator,fixup_charlen,resolve_fl_derived, + resolve_symbol): Ditto. + * symbol.c (gfc_new_charlen): New function to create a new gfc_charlen + structure and add it to a namespace. + (gfc_copy_formal_args_intr): Make sure ts.cl is present + for CHARACTER variables. + 2009-07-24 Jakub Jelinek PR fortran/40643 diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c index 4d3345f..2fee465 100644 --- a/gcc/fortran/array.c +++ b/gcc/fortran/array.c @@ -1599,9 +1599,7 @@ gfc_resolve_character_array_constructor (gfc_expr *expr) goto got_charlen; } - expr->ts.cl = gfc_get_charlen (); - expr->ts.cl->next = gfc_current_ns->cl_list; - gfc_current_ns->cl_list = expr->ts.cl; + expr->ts.cl = gfc_new_charlen (gfc_current_ns); } got_charlen: diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index e281634..0207683 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -1258,9 +1258,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.cl = gfc_get_charlen (); - sym->ts.cl->next = gfc_current_ns->cl_list; - gfc_current_ns->cl_list = sym->ts.cl; + sym->ts.cl = gfc_new_charlen (gfc_current_ns); if (sym->attr.flavor == FL_PARAMETER) { @@ -1292,9 +1290,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.cl = gfc_get_charlen (); - init->ts.cl->next = gfc_current_ns->cl_list; - gfc_current_ns->cl_list = sym->ts.cl; + init->ts.cl = gfc_new_charlen (gfc_current_ns); init->ts.cl->length = gfc_copy_expr (sym->ts.cl->length); for (p = init->value.constructor; p; p = p->next) @@ -1597,9 +1593,7 @@ variable_decl (int elem) switch (match_char_length (&char_len)) { case MATCH_YES: - cl = gfc_get_charlen (); - cl->next = gfc_current_ns->cl_list; - gfc_current_ns->cl_list = cl; + cl = gfc_new_charlen (gfc_current_ns); cl->length = char_len; break; @@ -1611,9 +1605,7 @@ variable_decl (int elem) && (current_ts.cl->length == NULL || current_ts.cl->length->expr_type != EXPR_CONSTANT)) { - cl = gfc_get_charlen (); - cl->next = gfc_current_ns->cl_list; - gfc_current_ns->cl_list = cl; + cl = gfc_new_charlen (gfc_current_ns); cl->length = gfc_copy_expr (current_ts.cl->length); } else @@ -2235,9 +2227,7 @@ done: } /* Do some final massaging of the length values. */ - cl = gfc_get_charlen (); - cl->next = gfc_current_ns->cl_list; - gfc_current_ns->cl_list = cl; + cl = gfc_new_charlen (gfc_current_ns); if (seen_length == 0) cl->length = gfc_int_expr (1); @@ -2611,9 +2601,7 @@ gfc_match_implicit (void) if (ts.type == BT_CHARACTER && !ts.cl) { ts.kind = gfc_default_character_kind; - ts.cl = gfc_get_charlen (); - ts.cl->next = gfc_current_ns->cl_list; - gfc_current_ns->cl_list = ts.cl; + ts.cl = gfc_new_charlen (gfc_current_ns); ts.cl->length = gfc_int_expr (1); } diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index a8f9f6a..df399b9 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -1681,9 +1681,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.cl = gfc_get_charlen (); - p->ts.cl->next = gfc_current_ns->cl_list; - gfc_current_ns->cl_list = p->ts.cl; + p->ts.cl = gfc_new_charlen (gfc_current_ns); p->ts.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 83c36c5..ce8e6fc 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -2415,6 +2415,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 *); 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 619d7e9..fdbf40c 100644 --- a/gcc/fortran/iresolve.c +++ b/gcc/fortran/iresolve.c @@ -63,11 +63,7 @@ static void check_charlen_present (gfc_expr *source) { if (source->ts.cl == NULL) - { - source->ts.cl = gfc_get_charlen (); - source->ts.cl->next = gfc_current_ns->cl_list; - gfc_current_ns->cl_list = source->ts.cl; - } + source->ts.cl = gfc_new_charlen (gfc_current_ns); if (source->expr_type == EXPR_CONSTANT) { @@ -165,9 +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.cl = gfc_get_charlen (); - f->ts.cl->next = gfc_current_ns->cl_list; - gfc_current_ns->cl_list = f->ts.cl; + f->ts.cl = gfc_new_charlen (gfc_current_ns); f->ts.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 f16f8d3..425bd36 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -2000,13 +2000,9 @@ mio_charlen (gfc_charlen **clp) { if (peek_atom () != ATOM_RPAREN) { - cl = gfc_get_charlen (); + cl = gfc_new_charlen (gfc_current_ns); mio_expr (&cl->length); - *clp = cl; - - cl->next = gfc_current_ns->cl_list; - gfc_current_ns->cl_list = cl; } } diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 376803d..e09167b 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -4012,11 +4012,7 @@ gfc_resolve_substring_charlen (gfc_expr *e) e->ts.kind = gfc_default_character_kind; if (!e->ts.cl) - { - e->ts.cl = gfc_get_charlen (); - e->ts.cl->next = gfc_current_ns->cl_list; - gfc_current_ns->cl_list = e->ts.cl; - } + e->ts.cl = gfc_new_charlen (gfc_current_ns); if (char_ref->u.ss.start) start = gfc_copy_expr (char_ref->u.ss.start); @@ -4489,9 +4485,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.cl = gfc_get_charlen (); - e->ts.cl->next = gfc_current_ns->cl_list; - gfc_current_ns->cl_list = e->ts.cl; + e->ts.cl = gfc_new_charlen (gfc_current_ns); if (!e1 || !e2) return; @@ -4530,11 +4524,7 @@ fixup_charlen (gfc_expr *e) default: if (!e->ts.cl) - { - e->ts.cl = gfc_get_charlen (); - e->ts.cl->next = gfc_current_ns->cl_list; - gfc_current_ns->cl_list = e->ts.cl; - } + e->ts.cl = gfc_new_charlen (gfc_current_ns); break; } @@ -9085,16 +9075,10 @@ resolve_fl_derived (gfc_symbol *sym) /* Copy char length. */ if (ifc->ts.cl) { - c->ts.cl = gfc_get_charlen(); + c->ts.cl = gfc_new_charlen (sym->ns); c->ts.cl->resolved = ifc->ts.cl->resolved; c->ts.cl->length = gfc_copy_expr (ifc->ts.cl->length); /* TODO: gfc_expr_replace_symbols (c->ts.cl->length, c);*/ - /* Add charlen to namespace. */ - /*if (c->formal_ns) - { - c->ts.cl->next = c->formal_ns->cl_list; - c->formal_ns->cl_list = c->ts.cl; - }*/ } } else if (c->ts.interface->name[0] != '\0') @@ -9490,16 +9474,10 @@ resolve_symbol (gfc_symbol *sym) /* Copy char length. */ if (ifc->ts.cl) { - sym->ts.cl = gfc_get_charlen(); + sym->ts.cl = gfc_new_charlen (sym->ns); sym->ts.cl->resolved = ifc->ts.cl->resolved; sym->ts.cl->length = gfc_copy_expr (ifc->ts.cl->length); gfc_expr_replace_symbols (sym->ts.cl->length, sym); - /* Add charlen to namespace. */ - if (sym->formal_ns) - { - sym->ts.cl->next = sym->formal_ns->cl_list; - sym->formal_ns->cl_list = sym->ts.cl; - } } } else if (sym->ts.interface->name[0] != '\0') diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 0c1a2fd..dd06e48 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -3071,6 +3071,19 @@ gfc_free_finalizer_list (gfc_finalizer* list) } +/* Create a new gfc_charlen structure and add it to a namespace. */ + +gfc_charlen* +gfc_new_charlen (gfc_namespace *ns) +{ + gfc_charlen *cl; + cl = gfc_get_charlen (); + cl->next = ns->cl_list; + ns->cl_list = cl; + return cl; +} + + /* Free the charlen list from cl to end (end is not freed). Free the whole list if end is NULL. */ @@ -3927,6 +3940,9 @@ gfc_copy_formal_args_intr (gfc_symbol *dest, gfc_intrinsic_sym *src) formal_arg->sym->attr.flavor = FL_VARIABLE; formal_arg->sym->attr.dummy = 1; + if (formal_arg->sym->ts.type == BT_CHARACTER) + formal_arg->sym->ts.cl = gfc_new_charlen (gfc_current_ns); + /* 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 anything other than NULL. */ diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 671f681..f6122c2 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2009-07-24 Janus Weil + + PR fortran/40822 + * gfortran.dg/char_length_16.f90: New. + 2009-07-24 Jakub Jelinek PR fortran/40643 diff --git a/gcc/testsuite/gfortran.dg/char_length_16.f90 b/gcc/testsuite/gfortran.dg/char_length_16.f90 new file mode 100644 index 0000000..3ff14d2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/char_length_16.f90 @@ -0,0 +1,12 @@ +! { dg-do compile } +! +! PR 40822: [4.5 Regression] Internal compiler error when Fortran intrinsic LEN referenced before explicit declaration +! +! Contributed by Mat Cross + +SUBROUTINE SEARCH(ITEMVAL) + CHARACTER (*) :: ITEMVAL + CHARACTER (LEN(ITEMVAL)) :: ITEM + INTRINSIC LEN +END + -- 2.7.4