From 88fec49fbb65368451cde61064b45d3ce12a29b8 Mon Sep 17 00:00:00 2001 From: Daniel Kraft Date: Tue, 17 Jun 2008 22:24:20 +0200 Subject: re PR fortran/36112 (Bounds-checking on character length not working for array-constructors) 2008-06-17 Daniel Kraft PR fortran/36112 * array.c (gfc_resolve_character_array_constructor): Check that all elements with constant character length have the same one rather than fixing it if no typespec is given, emit an error if they don't. Changed return type to "try" and return FAILURE for the case above. (gfc_resolve_array_constructor): Removed unneeded call to gfc_resolve_character_array_constructor in this function. * gfortran.h (gfc_resolve_character_array_constructor): Returns try. * trans-array.c (get_array_ctor_strlen): Return length of first element rather than last element. * resolve.c (gfc_resolve_expr): Handle FAILURE return from gfc_resolve_character_array_constructor. 2008-06-17 Daniel Kraft PR fortran/36112 * gfortran.dg/bounds_check_array_ctor_1.f90: New test. * gfortran.dg/bounds_check_array_ctor_2.f90: New test. * gfortran.dg/bounds_check_array_ctor_3.f90: New test. * gfortran.dg/bounds_check_array_ctor_4.f90: New test. * gfortran.dg/bounds_check_array_ctor_5.f90: New test. * gfortran.dg/bounds_check_array_ctor_6.f90: New test. * gfortran.dg/bounds_check_array_ctor_7.f90: New test. * gfortran.dg/bounds_check_array_ctor_8.f90: New test. * gfortran.dg/arrayio_0.f90: Fixed invalid array constructor. * gfortran.dg/char_cons_len.f90: Ditto. * gfortran.dg/char_initializer_actual.f90: Ditto. * gfortran.dg/pr15959.f90: Ditto. * gfortran.dg/transfer_simplify_2.f90: Ditto. * gfortran.dg/char_length_1.f90: Changed expected error messages. From-SVN: r136872 --- gcc/fortran/array.c | 115 +++++++++++++++++++++++++++++----------------------- 1 file changed, 64 insertions(+), 51 deletions(-) (limited to 'gcc/fortran/array.c') diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c index 5593289..73b78c3 100644 --- a/gcc/fortran/array.c +++ b/gcc/fortran/array.c @@ -1576,23 +1576,20 @@ 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. For arrays with fixed length, pad the - elements as necessary with needed_length. */ +/* Resolve character array constructor. If it has a specified constant character + length, pad/trunkate the elements here; if the length is not specified and + all elements are of compile-time known length, emit an error as this is + invalid. */ -void +try gfc_resolve_character_array_constructor (gfc_expr *expr) { gfc_constructor *p; - int max_length; - bool generated_length; + int found_length; gcc_assert (expr->expr_type == EXPR_ARRAY); gcc_assert (expr->ts.type == BT_CHARACTER); - max_length = -1; - if (expr->ts.cl == NULL) { for (p = expr->value.constructor; p; p = p->next) @@ -1611,15 +1608,16 @@ gfc_resolve_character_array_constructor (gfc_expr *expr) got_charlen: - generated_length = false; + found_length = -1; + if (expr->ts.cl->length == NULL) { - /* Find the maximum length of the elements. Do nothing for variable - array constructor, unless the character length is constant or - there is a constant substring reference. */ + /* Check that all constant string elements have the same length until + we reach the end or find a variable-length one. */ for (p = expr->value.constructor; p; p = p->next) { + int current_length = -1; gfc_ref *ref; for (ref = p->expr->ref; ref; ref = ref->next) if (ref->type == REF_SUBSTRING @@ -1628,32 +1626,43 @@ got_charlen: break; if (p->expr->expr_type == EXPR_CONSTANT) - max_length = MAX (p->expr->value.character.length, max_length); + current_length = p->expr->value.character.length; else if (ref) { long j; j = mpz_get_ui (ref->u.ss.end->value.integer) - mpz_get_ui (ref->u.ss.start->value.integer) + 1; - max_length = MAX ((int) j, max_length); + current_length = (int) j; } else if (p->expr->ts.cl && p->expr->ts.cl->length && p->expr->ts.cl->length->expr_type == EXPR_CONSTANT) { long j; j = mpz_get_si (p->expr->ts.cl->length->value.integer); - max_length = MAX ((int) j, max_length); + current_length = (int) j; } else - return; - } + return SUCCESS; - if (max_length != -1) - { - /* Update the character length of the array constructor. */ - expr->ts.cl->length = gfc_int_expr (max_length); - generated_length = true; - /* Real update follows below. */ + gcc_assert (current_length != -1); + + if (found_length == -1) + found_length = current_length; + else if (found_length != current_length) + { + gfc_error ("Different CHARACTER lengths (%d/%d) in array" + " constructor at %L", found_length, current_length, + &p->expr->where); + return FAILURE; + } + + gcc_assert (found_length == current_length); } + + gcc_assert (found_length != -1); + + /* Update the character length of the array constructor. */ + expr->ts.cl->length = gfc_int_expr (found_length); } else { @@ -1664,33 +1673,35 @@ got_charlen: /* If we've got a constant character length, pad according to this. gfc_extract_int does check for BT_INTEGER and EXPR_CONSTANT and sets max_length only if they pass. */ - gfc_extract_int (expr->ts.cl->length, &max_length); + gfc_extract_int (expr->ts.cl->length, &found_length); + + /* Now pad/trunkate the elements accordingly to the specified character + length. This is ok inside this conditional, as in the case above + (without typespec) all elements are verified to have the same length + anyway. */ + if (found_length != -1) + for (p = expr->value.constructor; p; p = p->next) + if (p->expr->expr_type == EXPR_CONSTANT) + { + gfc_expr *cl = NULL; + int current_length = -1; + + if (p->expr->ts.cl && p->expr->ts.cl->length) + { + cl = p->expr->ts.cl->length; + gfc_extract_int (cl, ¤t_length); + } + + /* If gfc_extract_int above set current_length, we implicitly + know the type is BT_INTEGER and it's EXPR_CONSTANT. */ + + if (! cl + || (current_length != -1 && current_length < found_length)) + gfc_set_constant_character_len (found_length, p->expr, true); + } } - /* Found a length to update to, do it for all element strings shorter than - the target length. */ - if (max_length != -1) - { - for (p = expr->value.constructor; p; p = p->next) - if (p->expr->expr_type == EXPR_CONSTANT) - { - gfc_expr *cl = NULL; - int current_length = -1; - - if (p->expr->ts.cl && p->expr->ts.cl->length) - { - cl = p->expr->ts.cl->length; - gfc_extract_int (cl, ¤t_length); - } - - /* If gfc_extract_int above set current_length, we implicitly - know the type is BT_INTEGER and it's EXPR_CONSTANT. */ - - if (generated_length || ! cl - || (current_length != -1 && current_length < max_length)) - gfc_set_constant_character_len (max_length, p->expr, true); - } - } + return SUCCESS; } @@ -1704,8 +1715,10 @@ 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) - gfc_resolve_character_array_constructor (expr); + + /* gfc_resolve_character_array_constructor is called in gfc_resolve_expr after + the call to this function, so we don't need to call it here; if it was + called twice, an error message there would be duplicated. */ return t; } -- cgit v1.1