diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index d7dff6d435d..f8aa502dd4a 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,13 @@ +2011-02-19 Paul Thomas + + PR fortran/47348 + * trans-array.c (get_array_ctor_all_strlen): Move up in file. + (get_array_ctor_var_strlen): Add block dummy and add call to + get_array_ctor_all_strlen instead of giving up on substrings. + Call gcc_unreachable for default case. + (get_array_ctor_strlen): Add extra argument to in call to + get_array_ctor_var_strlen. + 2011-02-18 Janus Weil PR fortran/47789 diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 4dc69d25c26..83f0189de75 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -1495,60 +1495,9 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type, } -/* Figure out the string length of a variable reference expression. - Used by get_array_ctor_strlen. */ - -static void -get_array_ctor_var_strlen (gfc_expr * expr, tree * len) -{ - gfc_ref *ref; - gfc_typespec *ts; - mpz_t char_len; - - /* Don't bother if we already know the length is a constant. */ - if (*len && INTEGER_CST_P (*len)) - return; - - ts = &expr->symtree->n.sym->ts; - for (ref = expr->ref; ref; ref = ref->next) - { - switch (ref->type) - { - case REF_ARRAY: - /* Array references don't change the string length. */ - break; - - case REF_COMPONENT: - /* Use the length of the component. */ - ts = &ref->u.c.component->ts; - break; - - case REF_SUBSTRING: - if (ref->u.ss.start->expr_type != EXPR_CONSTANT - || ref->u.ss.end->expr_type != EXPR_CONSTANT) - break; - mpz_init_set_ui (char_len, 1); - mpz_add (char_len, char_len, ref->u.ss.end->value.integer); - mpz_sub (char_len, char_len, ref->u.ss.start->value.integer); - *len = gfc_conv_mpz_to_tree (char_len, gfc_default_integer_kind); - *len = convert (gfc_charlen_type_node, *len); - mpz_clear (char_len); - return; - - default: - /* TODO: Substrings are tricky because we can't evaluate the - expression more than once. For now we just give up, and hope - we can figure it out elsewhere. */ - return; - } - } - - *len = ts->u.cl->backend_decl; -} - - /* A catch-all to obtain the string length for anything that is not a - constant, array or variable. */ + a substring of non-constant length, a constant, array or variable. */ + static void get_array_ctor_all_strlen (stmtblock_t *block, gfc_expr *e, tree *len) { @@ -1590,6 +1539,59 @@ get_array_ctor_all_strlen (stmtblock_t *block, gfc_expr *e, tree *len) } +/* Figure out the string length of a variable reference expression. + Used by get_array_ctor_strlen. */ + +static void +get_array_ctor_var_strlen (stmtblock_t *block, gfc_expr * expr, tree * len) +{ + gfc_ref *ref; + gfc_typespec *ts; + mpz_t char_len; + + /* Don't bother if we already know the length is a constant. */ + if (*len && INTEGER_CST_P (*len)) + return; + + ts = &expr->symtree->n.sym->ts; + for (ref = expr->ref; ref; ref = ref->next) + { + switch (ref->type) + { + case REF_ARRAY: + /* Array references don't change the string length. */ + break; + + case REF_COMPONENT: + /* Use the length of the component. */ + ts = &ref->u.c.component->ts; + break; + + case REF_SUBSTRING: + if (ref->u.ss.start->expr_type != EXPR_CONSTANT + || ref->u.ss.end->expr_type != EXPR_CONSTANT) + { + /* Note that this might evaluate expr. */ + get_array_ctor_all_strlen (block, expr, len); + return; + } + mpz_init_set_ui (char_len, 1); + mpz_add (char_len, char_len, ref->u.ss.end->value.integer); + mpz_sub (char_len, char_len, ref->u.ss.start->value.integer); + *len = gfc_conv_mpz_to_tree (char_len, gfc_default_integer_kind); + *len = convert (gfc_charlen_type_node, *len); + mpz_clear (char_len); + return; + + default: + gcc_unreachable (); + } + } + + *len = ts->u.cl->backend_decl; +} + + /* 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, @@ -1633,7 +1635,7 @@ get_array_ctor_strlen (stmtblock_t *block, gfc_constructor_base base, tree * len case EXPR_VARIABLE: is_const = false; if (len) - get_array_ctor_var_strlen (c->expr, len); + get_array_ctor_var_strlen (block, c->expr, len); break; default: diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 8b6199f6818..f1076f6ffdc 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,21 @@ +2011-02-19 Paul Thomas + + PR fortran/47348 + * trans-array.c (get_array_ctor_all_strlen): Move up in file. + (get_array_ctor_var_strlen): Add block dummy and add call to + get_array_ctor_all_strlen instead of giving up on substrings. + Call gcc_unreachable for default case. + (get_array_ctor_strlen): Add extra argument to in call to + get_array_ctor_var_strlen. + +2011-02-19 Paul Thomas + + PR fortran/47348 + * gfortran.dg/array_constructor_36.f90 : New test. + * gfortran.dg/bounds_check_10.f90 : Change dg-output message to + allow for comparison between different elements of the array + constructor at different levels of optimization. + 2011-02-19 H.J. Lu * gcc.target/i386/pr31167.c: Require int128 instead of lp64. diff --git a/gcc/testsuite/gfortran.dg/array_constructor_36.f90 b/gcc/testsuite/gfortran.dg/array_constructor_36.f90 new file mode 100644 index 00000000000..a74d256d95e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/array_constructor_36.f90 @@ -0,0 +1,21 @@ +! { dg-do run } +! Test the fix for PR47348, in which the substring length +! in the array constructor at line 19 would be missed and +! the length of q used instead. +! +! Contributed by Thomas Koenig +! +program main + implicit none + character(len = *), parameter :: fmt='(2(A,"|"))' + character(len = *), parameter :: test='xyc|aec|' + integer :: i + character(len = 4) :: q + character(len = 8) :: buffer + q = 'xy' + i = 2 + write (buffer, fmt) (/ trim(q), 'ae' /)//'c' + if (buffer .ne. test) Call abort + write (buffer, FMT) (/ q(1:i), 'ae' /)//'c' + if (buffer .ne. test) Call abort +end program main diff --git a/gcc/testsuite/gfortran.dg/bounds_check_10.f90 b/gcc/testsuite/gfortran.dg/bounds_check_10.f90 index 3aba1cb6ab6..66bc308f060 100644 --- a/gcc/testsuite/gfortran.dg/bounds_check_10.f90 +++ b/gcc/testsuite/gfortran.dg/bounds_check_10.f90 @@ -12,4 +12,4 @@ z = [y(1:1), y(1:1), x(1:len(trim(x)))] ! should work z = [trim(x), trim(y), "aaaa"] ! [ "a", "cd", "aaaa" ] should catch first error end program array_char -! { dg-output "Different CHARACTER lengths .1/2. in array constructor" } +! { dg-output "Different CHARACTER lengths .1/.. in array constructor" }