From df7cc9b576724e644cbc9d01c73b7a973866739c Mon Sep 17 00:00:00 2001 From: Feng Wang Date: Tue, 5 Apr 2005 08:54:50 +0000 Subject: re PR fortran/15959 (ICE and assertion failure in trans-decl.c with character initialization) 2005-04-05 Feng Wang PR fortran/15959 PR fortran/20713 * array.c (resolve_character_array_constructor): New function. Set constant character array's character length. (gfc_resolve_array_constructor): Use it. * decl.c (add_init_expr_to_sym): Set symbol and initializer character length. (gfc_set_constant_character_len): New function. Set constant character expression according the given length. * match.h (gfc_set_constant_character_len): Add prototype. 2005-04-05 Feng Wang * gfortran.dg/pr15959.f90: New test. * gfortran.dg/string_pad_trunc.f90: New test. From-SVN: r97613 --- gcc/fortran/decl.c | 53 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 53 insertions(+) (limited to 'gcc/fortran/decl.c') diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 5f6c075..4a566a9 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -646,6 +646,30 @@ build_sym (const char *name, gfc_charlen * cl, return SUCCESS; } +/* Set character constant to the given length. The constant will be padded or + truncated. */ + +void +gfc_set_constant_character_len (int len, gfc_expr * expr) +{ + char * s; + int slen; + + gcc_assert (expr->expr_type == EXPR_CONSTANT); + gcc_assert (expr->ts.type == BT_CHARACTER && expr->ts.kind == 1); + + slen = expr->value.character.length; + if (len != slen) + { + s = gfc_getmem (len); + memcpy (s, expr->value.character.string, MIN (len, slen)); + if (len > slen) + memset (&s[slen], ' ', len - slen); + gfc_free (expr->value.character.string); + expr->value.character.string = s; + expr->value.character.length = len; + } +} /* Function called by variable_decl() that adds an initialization expression to a symbol. */ @@ -711,6 +735,35 @@ add_init_expr_to_sym (const char *name, gfc_expr ** initp, && gfc_check_assign_symbol (sym, init) == FAILURE) return FAILURE; + if (sym->ts.type == BT_CHARACTER && sym->ts.cl) + { + /* Update symbol character length according initializer. */ + if (sym->ts.cl->length == NULL) + { + if (init->expr_type == EXPR_CONSTANT) + sym->ts.cl->length = + gfc_int_expr (init->value.character.length); + else if (init->expr_type == EXPR_ARRAY) + sym->ts.cl->length = gfc_copy_expr (init->ts.cl->length); + } + /* Update initializer character length according symbol. */ + else if (sym->ts.cl->length->expr_type == EXPR_CONSTANT) + { + int len = mpz_get_si (sym->ts.cl->length->value.integer); + gfc_constructor * p; + + if (init->expr_type == EXPR_CONSTANT) + gfc_set_constant_character_len (len, init); + else if (init->expr_type == EXPR_ARRAY) + { + gfc_free_expr (init->ts.cl->length); + init->ts.cl->length = gfc_copy_expr (sym->ts.cl->length); + for (p = init->value.constructor; p; p = p->next) + gfc_set_constant_character_len (len, p->expr); + } + } + } + /* Add initializer. Make sure we keep the ranks sane. */ if (sym->attr.dimension && init->rank == 0) init->rank = sym->as->rank; -- cgit v1.1