diff options
20 files changed, 243 insertions, 69 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 1bf3c93..e83c3cb 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,18 @@ +2008-06-17 Daniel Kraft <d@domob.eu> + + 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 Paul Thomas <pault@gcc.gnu.org> PR fortran/34396 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; } diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 8665a48..ee60f9a 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -2363,7 +2363,7 @@ void gfc_simplify_iterator_var (gfc_expr *); try gfc_expand_constructor (gfc_expr *); int gfc_constant_ac (gfc_expr *); int gfc_expanded_ac (gfc_expr *); -void gfc_resolve_character_array_constructor (gfc_expr *); +try gfc_resolve_character_array_constructor (gfc_expr *); try gfc_resolve_array_constructor (gfc_expr *); try gfc_check_constructor_type (gfc_expr *); try gfc_check_iter_variable (gfc_expr *); diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 37bafd0..3b798d8 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -4342,8 +4342,8 @@ gfc_resolve_expr (gfc_expr *e) /* This provides the opportunity for the length of constructors with character valued function elements to propagate the string length to the expression. */ - if (e->ts.type == BT_CHARACTER) - gfc_resolve_character_array_constructor (e); + if (t == SUCCESS && e->ts.type == BT_CHARACTER) + t = gfc_resolve_character_array_constructor (e); break; diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 7df192c..2a96698 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -1459,6 +1459,9 @@ get_array_ctor_all_strlen (stmtblock_t *block, gfc_expr *e, tree *len) /* Figure out the string length of a character array constructor. + If len is NULL, don't calculate the length; this happens for recursive calls + when a sub-array-constructor is an element but not at the first position, + so when we're not interested in the length. Returns TRUE if all elements are character constants. */ bool @@ -1470,16 +1473,20 @@ get_array_ctor_strlen (stmtblock_t *block, gfc_constructor * c, tree * len) if (c == NULL) { - *len = build_int_cstu (gfc_charlen_type_node, 0); + if (len) + *len = build_int_cstu (gfc_charlen_type_node, 0); return is_const; } - for (; c; c = c->next) + /* Loop over all constructor elements to find out is_const, but in len we + want to store the length of the first, not the last, element. We can + of course exit the loop as soon as is_const is found to be false. */ + for (; c && is_const; c = c->next) { switch (c->expr->expr_type) { case EXPR_CONSTANT: - if (!(*len && INTEGER_CST_P (*len))) + if (len && !(*len && INTEGER_CST_P (*len))) *len = build_int_cstu (gfc_charlen_type_node, c->expr->value.character.length); break; @@ -1491,14 +1498,19 @@ get_array_ctor_strlen (stmtblock_t *block, gfc_constructor * c, tree * len) case EXPR_VARIABLE: is_const = false; - get_array_ctor_var_strlen (c->expr, len); + if (len) + get_array_ctor_var_strlen (c->expr, len); break; default: is_const = false; - get_array_ctor_all_strlen (block, c->expr, len); + if (len) + get_array_ctor_all_strlen (block, c->expr, len); break; } + + /* After the first iteration, we don't want the length modified. */ + len = NULL; } return is_const; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 4f29172..8b2d63c 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,21 @@ +2008-06-17 Daniel Kraft <d@domob.eu> + + 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. + 2008-06-17 Paul Thomas <pault@gcc.gnu.org> PR fortran/36366 diff --git a/gcc/testsuite/gfortran.dg/arrayio_0.f90 b/gcc/testsuite/gfortran.dg/arrayio_0.f90 index 1331cf2..3801a69 100644 --- a/gcc/testsuite/gfortran.dg/arrayio_0.f90 +++ b/gcc/testsuite/gfortran.dg/arrayio_0.f90 @@ -8,7 +8,7 @@ character(len=48), dimension(2) :: iue equivalence (iu, iue) integer, dimension(4) :: v = (/2,1,4,3/) - iu = (/"Vector","subscripts","not","allowed!"/) + iu = (/"Vector ","subscripts","not ","allowed! "/) read (iu, '(a12/)') buff read (iue(1), '(4a12)') buff read (iu(4:1:-1), '(a12/)') buff diff --git a/gcc/testsuite/gfortran.dg/bounds_check_array_ctor_1.f90 b/gcc/testsuite/gfortran.dg/bounds_check_array_ctor_1.f90 new file mode 100644 index 0000000..45b21d2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/bounds_check_array_ctor_1.f90 @@ -0,0 +1,16 @@ +! { dg-do run } +! { dg-options "-fbounds-check" } +! { dg-shouldfail "foo" } +! +! PR 36112 +! Check correct bounds-checking behaviour for character-array-constructors. + + call test ("this is long") +contains + subroutine test(s) + character(len=*) :: s + character(len=128) :: arr(2) + arr = (/ s, "abc" /) + end subroutine test +end +! { dg-output "Different CHARACTER lengths \\(12/3\\) in array constructor" } diff --git a/gcc/testsuite/gfortran.dg/bounds_check_array_ctor_2.f90 b/gcc/testsuite/gfortran.dg/bounds_check_array_ctor_2.f90 new file mode 100644 index 0000000..e0cbf10 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/bounds_check_array_ctor_2.f90 @@ -0,0 +1,16 @@ +! { dg-do run } +! { dg-options "-fbounds-check" } +! { dg-shouldfail "foo" } +! +! PR 36112 +! Check correct bounds-checking behaviour for character-array-constructors. + + call test ("this is long") +contains + subroutine test(s) + character(len=*) :: s + character(len=128) :: arr(2) + arr = (/ "abc", s /) + end subroutine test +end +! { dg-output "Different CHARACTER lengths \\(3/12\\) in array constructor" } diff --git a/gcc/testsuite/gfortran.dg/bounds_check_array_ctor_3.f90 b/gcc/testsuite/gfortran.dg/bounds_check_array_ctor_3.f90 new file mode 100644 index 0000000..5e566ba --- /dev/null +++ b/gcc/testsuite/gfortran.dg/bounds_check_array_ctor_3.f90 @@ -0,0 +1,9 @@ +! { dg-do compile } +! +! PR 36112 +! Check correct bounds-checking behaviour for character-array-constructors. +! This should not need any -fbounds-check and is enabled all the time. + + character(len=128) :: arr(2) = (/ "abc", "foobar" /) ! { dg-error "Different CHARACTER lengths" } + arr = (/ "abc", "foobar" /) ! { dg-error "Different CHARACTER lengths" } +end diff --git a/gcc/testsuite/gfortran.dg/bounds_check_array_ctor_4.f90 b/gcc/testsuite/gfortran.dg/bounds_check_array_ctor_4.f90 new file mode 100644 index 0000000..1d3bac8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/bounds_check_array_ctor_4.f90 @@ -0,0 +1,16 @@ +! { dg-do run } +! { dg-options "-fbounds-check" } +! { dg-shouldfail "foo" } +! +! PR 36112 +! Check correct bounds-checking behaviour for character-array-constructors. + + call test ("short", "this is long") +contains + subroutine test(r, s) + character(len=*) :: r, s + character(len=128) :: arr(2) + arr = (/ r, s /) + end subroutine test +end +! { dg-output "Different CHARACTER lengths \\(5/12\\) in array constructor" } diff --git a/gcc/testsuite/gfortran.dg/bounds_check_array_ctor_5.f90 b/gcc/testsuite/gfortran.dg/bounds_check_array_ctor_5.f90 new file mode 100644 index 0000000..ad7f1b0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/bounds_check_array_ctor_5.f90 @@ -0,0 +1,10 @@ +! { dg-do compile } +! +! PR 36112 +! Check correct bounds-checking behaviour for character-array-constructors. +! No need for -fbounds-check, enabled unconditionally. + + character(len=5) :: s = "hello" + character(len=128) :: arr(3) + arr = (/ "abc", "foo", s /) ! { dg-error "Different CHARACTER lengths" } +end diff --git a/gcc/testsuite/gfortran.dg/bounds_check_array_ctor_6.f90 b/gcc/testsuite/gfortran.dg/bounds_check_array_ctor_6.f90 new file mode 100644 index 0000000..c6f89e0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/bounds_check_array_ctor_6.f90 @@ -0,0 +1,16 @@ +! { dg-do run } +! { dg-options "-fbounds-check" } +! { dg-shouldfail "foo" } +! +! PR 36112 +! Check correct bounds-checking behaviour for character-array-constructors. + + call test ("short", "also5") +contains + subroutine test(r, s) + character(len=*) :: r, s + character(len=128) :: arr(3) + arr = (/ r, s, "this is too long" /) + end subroutine test +end +! { dg-output "Different CHARACTER lengths \\(5/16\\) in array constructor" } diff --git a/gcc/testsuite/gfortran.dg/bounds_check_array_ctor_7.f90 b/gcc/testsuite/gfortran.dg/bounds_check_array_ctor_7.f90 new file mode 100644 index 0000000..2a13be2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/bounds_check_array_ctor_7.f90 @@ -0,0 +1,16 @@ +! { dg-do run } +! { dg-options "-fbounds-check" } +! { dg-shouldfail "foo" } +! +! PR 36112 +! Check correct bounds-checking behaviour for character-array-constructors. + + call test ("short") +contains + subroutine test(s) + character(len=*) :: s + character(len=128) :: arr(3) + arr = (/ "this is long", "this one too", s /) + end subroutine test +end +! { dg-output "Different CHARACTER lengths \\(12/5\\) in array constructor" } diff --git a/gcc/testsuite/gfortran.dg/bounds_check_array_ctor_8.f90 b/gcc/testsuite/gfortran.dg/bounds_check_array_ctor_8.f90 new file mode 100644 index 0000000..0d4ad0c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/bounds_check_array_ctor_8.f90 @@ -0,0 +1,16 @@ +! { dg-do run } +! { dg-options "-fbounds-check" } +! { dg-shouldfail "foo" } +! +! PR 36112 +! Check correct bounds-checking behaviour for character-array-constructors. + + call test ("short") +contains + subroutine test(s) + character(len=*) :: s + character(len=128) :: arr(3) + arr = (/ s, "this is long", "this one too" /) + end subroutine test +end +! { dg-output "Different CHARACTER lengths \\(5/12\\) in array constructor" } diff --git a/gcc/testsuite/gfortran.dg/char_cons_len.f90 b/gcc/testsuite/gfortran.dg/char_cons_len.f90 index e50d753..cf920bd 100644 --- a/gcc/testsuite/gfortran.dg/char_cons_len.f90 +++ b/gcc/testsuite/gfortran.dg/char_cons_len.f90 @@ -3,7 +3,7 @@ ! constructor, as an argument for LEN, would cause an ICE. ! character(11) :: chr1, chr2 - i = len ((/chr1, chr2, "ggg"/)) + i = len ((/chr1, chr2, "ggg "/)) j = len ((/"abcdefghijk", chr1, chr2/)) k = len ((/'hello ','goodbye'/)) l = foo ("yes siree, Bob") diff --git a/gcc/testsuite/gfortran.dg/char_initialiser_actual.f90 b/gcc/testsuite/gfortran.dg/char_initialiser_actual.f90 index 7975a7e..920e106 100644 --- a/gcc/testsuite/gfortran.dg/char_initialiser_actual.f90 +++ b/gcc/testsuite/gfortran.dg/char_initialiser_actual.f90 @@ -5,10 +5,10 @@ program char_initialiser character*5, dimension(3) :: x character*5, dimension(:), pointer :: y - x=(/"is Ja","ne Fo","nda"/) + x=(/"is Ja","ne Fo","nda "/) call sfoo ("is Ja", x(1)) - call afoo ((/"is Ja","ne Fo","nda"/), x) - y => pfoo ((/"is Ja","ne Fo","nda"/)) + call afoo ((/"is Ja","ne Fo","nda "/), x) + y => pfoo ((/"is Ja","ne Fo","nda "/)) call afoo (y, x) contains subroutine sfoo(ch1, ch2) diff --git a/gcc/testsuite/gfortran.dg/char_length_1.f90 b/gcc/testsuite/gfortran.dg/char_length_1.f90 index e372343..3f92f0e 100644 --- a/gcc/testsuite/gfortran.dg/char_length_1.f90 +++ b/gcc/testsuite/gfortran.dg/char_length_1.f90 @@ -7,12 +7,13 @@ ! Contributed by Tobias Burnus <tobias.burnus@physik.fu-berlin.de> ! program test + implicit none character(10) :: a(3) character(10) :: b(3)= & - (/ 'Takata ', 'Tanaka', 'Hayashi' /) ! { dg-error "same length" } + (/ 'Takata ', 'Tanaka', 'Hayashi' /) ! { dg-error "Different CHARACTER" } character(4) :: c = "abcde" ! { dg-warning "being truncated" } - a = (/ 'Takata', 'Tanaka ', 'Hayashi' /) ! { dg-error "same length" } + a = (/ 'Takata', 'Tanaka ', 'Hayashi' /) ! { dg-error "Different CHARACTER" } a = (/ 'Takata ', 'Tanaka ', 'Hayashi' /) - b = "abc" + b = "abc" ! { dg-error "no IMPLICIT" } c = "abcdefg" ! { dg-warning "will be truncated" } end program test diff --git a/gcc/testsuite/gfortran.dg/pr15959.f90 b/gcc/testsuite/gfortran.dg/pr15959.f90 index b7f3719..c28dce5 100644 --- a/gcc/testsuite/gfortran.dg/pr15959.f90 +++ b/gcc/testsuite/gfortran.dg/pr15959.f90 @@ -1,5 +1,5 @@ ! { dg-do run } ! Test initializer of character array. PR15959 -character (*), parameter :: a (1:2) = (/'ab', 'abc'/) +character (*), parameter :: a (1:2) = (/'ab ', 'abc'/) if (a(2) .ne. 'abc') call abort() end diff --git a/gcc/testsuite/gfortran.dg/transfer_simplify_2.f90 b/gcc/testsuite/gfortran.dg/transfer_simplify_2.f90 index a4da6a5..96bf283 100644 --- a/gcc/testsuite/gfortran.dg/transfer_simplify_2.f90 +++ b/gcc/testsuite/gfortran.dg/transfer_simplify_2.f90 @@ -92,7 +92,7 @@ contains end subroutine integer8_to_complex4 subroutine character16_to_complex8 - character(16), parameter :: c1(2) = (/"abcdefghijklmnop","qrstuvwxyz1234567890"/) + character(16), parameter :: c1(2) = (/"abcdefghijklmnop","qrstuvwxyz123456"/) character(16) :: c2(2) = c1 complex(8), parameter :: z1(2) = transfer (c1, (1.0_8,1.0_8), 2) complex(8) :: z2(2) |