From: Feng Wang Date: Tue, 5 Apr 2005 08:54:50 +0000 (+0000) Subject: re PR fortran/15959 (ICE and assertion failure in trans-decl.c with character initial... X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=df7cc9b576724e644cbc9d01c73b7a973866739c;p=gcc.git 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 --- diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c index 4f4f19b100b..dc660d45580 100644 --- a/gcc/fortran/array.c +++ b/gcc/fortran/array.c @@ -1499,9 +1499,45 @@ resolve_array_list (gfc_constructor * p) return t; } +/* Resolve character array constructor. If it is a constant character array and + not specified character length, update character length to the maximum of + its element constructors' length. */ -/* Resolve all of the expressions in an array list. - TODO: String lengths. */ +static void +resolve_character_array_constructor (gfc_expr * expr) +{ + gfc_constructor * p; + int max_length; + + gcc_assert (expr->expr_type == EXPR_ARRAY); + gcc_assert (expr->ts.type == BT_CHARACTER); + + max_length = -1; + + if (expr->ts.cl == NULL || expr->ts.cl->length == NULL) + { + /* Find the maximum length of the elements. Do nothing for variable array + constructor. */ + for (p = expr->value.constructor; p; p = p->next) + if (p->expr->expr_type == EXPR_CONSTANT) + max_length = MAX (p->expr->value.character.length, max_length); + else + return; + + if (max_length != -1) + { + /* Update the character length of the array constructor. */ + if (expr->ts.cl == NULL) + expr->ts.cl = gfc_get_charlen (); + expr->ts.cl->length = gfc_int_expr (max_length); + /* Update the element constructors. */ + for (p = expr->value.constructor; p; p = p->next) + gfc_set_constant_character_len (max_length, p->expr); + } + } +} + +/* Resolve all of the expressions in an array list. */ try gfc_resolve_array_constructor (gfc_expr * expr) @@ -1511,6 +1547,8 @@ gfc_resolve_array_constructor (gfc_expr * expr) t = resolve_array_list (expr->value.constructor); if (t == SUCCESS) t = gfc_check_constructor_type (expr); + if (t == SUCCESS && expr->ts.type == BT_CHARACTER) + resolve_character_array_constructor (expr); return t; } diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 5f6c075d680..4a566a99cff 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; diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h index 1d46e85960c..2351f9b92bf 100644 --- a/gcc/fortran/match.h +++ b/gcc/fortran/match.h @@ -108,6 +108,8 @@ match gfc_match_derived_decl (void); match gfc_match_implicit_none (void); match gfc_match_implicit (void); +void gfc_set_constant_character_len (int, gfc_expr *); + /* Matchers for attribute declarations */ match gfc_match_allocatable (void); match gfc_match_dimension (void); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 5aeaad9a25f..58d473c18bb 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2005-04-05 Feng Wang + + * gfortran.dg/pr15959.f90: New test. + * gfortran.dg/string_pad_trunc.f90: New test. + 2005-04-05 Francois-Xavier Coudert * gfortran.dg/backspace.f, gfortran.dg/g77_intrinsics_funcs.f, diff --git a/gcc/testsuite/gfortran.dg/pr15959.f90 b/gcc/testsuite/gfortran.dg/pr15959.f90 new file mode 100644 index 00000000000..b7f3719dfe4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr15959.f90 @@ -0,0 +1,5 @@ +! { dg-do run } +! Test initializer of character array. PR15959 +character (*), parameter :: a (1:2) = (/'ab', 'abc'/) +if (a(2) .ne. 'abc') call abort() +end diff --git a/gcc/testsuite/gfortran.dg/string_pad_trunc.f90 b/gcc/testsuite/gfortran.dg/string_pad_trunc.f90 new file mode 100644 index 00000000000..738a181b962 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/string_pad_trunc.f90 @@ -0,0 +1,20 @@ +! { dg-do run } +! PR20713. Pad and truncate string. + +character(len = 6),parameter:: a = 'hello' +character(len = 6),parameter:: b = 'hello *' +character(len = 6),parameter:: c (1:1) = 'hello' +character(len = 11) line + +write (line, '(6A)') a, 'world' +if (line .ne. 'hello world') call abort + +write (line, '(6A)') b, 'world' +if (line .ne. 'hello world') call abort + +write (line, '(6A)') c, 'world' +if (line .ne. 'hello world') call abort + +write (line, '(6A)') c(1), 'world' +if (line .ne. 'hello world') call abort +end