From d28480827e3674794d7d6793148c737d491bc9ba Mon Sep 17 00:00:00 2001 From: Daniel Kraft Date: Wed, 18 Jun 2008 15:53:32 +0200 Subject: PR fortran/36517, fortran/36492 2008-06-18 Daniel Kraft PR fortran/36517, fortran/36492 * gfortran.dg/array_constructor_25.f03: New test. * gfortran.dg/array_constructor_26.f03: New test. * gfortran.dg/array_constructor_27.f03: New test. * gfortran.dg/array_constructor_28.f03: New test. * gfortran.dg/array_constructor_29.f03: New test. * gfortran.dg/array_constructor_30.f03: New test. * gfortran.dg/array_constructor_type_19.f03: New test. * gfortran.dg/array_constructor_type_20.f03: New test. * gfortran.dg/array_constructor_type_21.f03: New test. 2008-06-18 Daniel Kraft PR fortran/36517, fortran/36492 * array.c (gfc_resolve_character_array_constructor): Call gfc_set_constant_character_len with changed length-chec argument. * decl.c (gfc_set_constant_character_len): Changed array argument to be a generic length-checking argument that can be used for correct checking with typespec and in special cases where the should-be length is different from the target length. (build_struct): Call gfc_set_constant_character_len with changed length checking argument and introduced additional checks for exceptional conditions on invalid code. (add_init_expr_to_sym), (do_parm): Call gfc_set_constant_character_len with changed argument. * match.h (gfc_set_constant_character_len): Changed third argument to int for the should-be length rather than bool. From-SVN: r136894 --- gcc/fortran/decl.c | 58 ++++++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 45 insertions(+), 13 deletions(-) (limited to 'gcc/fortran/decl.c') diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index a1c7d5a..57db93f 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -1084,10 +1084,12 @@ build_sym (const char *name, gfc_charlen *cl, /* Set character constant to the given length. The constant will be padded or - truncated. */ + truncated. If we're inside an array constructor without a typespec, we + additionally check that all elements have the same length; check_len -1 + means no checking. */ void -gfc_set_constant_character_len (int len, gfc_expr *expr, bool array) +gfc_set_constant_character_len (int len, gfc_expr *expr, int check_len) { gfc_char_t *s; int slen; @@ -1110,10 +1112,11 @@ gfc_set_constant_character_len (int len, gfc_expr *expr, bool array) /* Apply the standard by 'hand' otherwise it gets cleared for initializers. */ - if (array && slen < len && !(gfc_option.allow_std & GFC_STD_GNU)) + if (check_len != -1 && slen != check_len + && !(gfc_option.allow_std & GFC_STD_GNU)) gfc_error_now ("The CHARACTER elements of the array constructor " "at %L must have the same length (%d/%d)", - &expr->where, slen, len); + &expr->where, slen, check_len); s[len] = '\0'; gfc_free (expr->value.character.string); @@ -1269,7 +1272,7 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus) gfc_constructor * p; if (init->expr_type == EXPR_CONSTANT) - gfc_set_constant_character_len (len, init, false); + gfc_set_constant_character_len (len, init, -1); else if (init->expr_type == EXPR_ARRAY) { /* Build a new charlen to prevent simplification from @@ -1280,7 +1283,7 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus) 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, false); + gfc_set_constant_character_len (len, p->expr, -1); } } } @@ -1402,19 +1405,48 @@ build_struct (const char *name, gfc_charlen *cl, gfc_expr **init, /* Should this ever get more complicated, combine with similar section in add_init_expr_to_sym into a separate function. */ - if (c->ts.type == BT_CHARACTER && !c->pointer && c->initializer) + if (c->ts.type == BT_CHARACTER && !c->pointer && c->initializer && c->ts.cl + && c->ts.cl->length && c->ts.cl->length->expr_type == EXPR_CONSTANT) { - int len = mpz_get_si (c->ts.cl->length->value.integer); + int len; + + gcc_assert (c->ts.cl && c->ts.cl->length); + gcc_assert (c->ts.cl->length->expr_type == EXPR_CONSTANT); + gcc_assert (c->ts.cl->length->ts.type == BT_INTEGER); + + len = mpz_get_si (c->ts.cl->length->value.integer); if (c->initializer->expr_type == EXPR_CONSTANT) - gfc_set_constant_character_len (len, c->initializer, false); + gfc_set_constant_character_len (len, c->initializer, -1); else if (mpz_cmp (c->ts.cl->length->value.integer, c->initializer->ts.cl->length->value.integer)) { + bool has_ts; gfc_constructor *ctor = c->initializer->value.constructor; - for (;ctor ; ctor = ctor->next) - if (ctor->expr->expr_type == EXPR_CONSTANT) - gfc_set_constant_character_len (len, ctor->expr, true); + + bool first = true; + int first_len; + + has_ts = (c->initializer->ts.cl + && c->initializer->ts.cl->length_from_typespec); + + for (; ctor; ctor = ctor->next) + { + /* Remember the length of the first element for checking that + all elements *in the constructor* have the same length. This + need not be the length of the LHS! */ + if (first) + { + gcc_assert (ctor->expr->expr_type == EXPR_CONSTANT); + gcc_assert (ctor->expr->ts.type == BT_CHARACTER); + first_len = ctor->expr->value.character.length; + first = false; + } + + if (ctor->expr->expr_type == EXPR_CONSTANT) + gfc_set_constant_character_len (len, ctor->expr, + has_ts ? -1 : first_len); + } } } @@ -5822,7 +5854,7 @@ do_parm (void) && init->expr_type == EXPR_CONSTANT && init->ts.type == BT_CHARACTER) gfc_set_constant_character_len ( - mpz_get_si (sym->ts.cl->length->value.integer), init, false); + mpz_get_si (sym->ts.cl->length->value.integer), init, -1); else if (sym->ts.type == BT_CHARACTER && sym->ts.cl != NULL && sym->ts.cl->length == NULL) { -- cgit v1.1