diff options
| -rw-r--r-- | gcc/fortran/ChangeLog | 7 | ||||
| -rw-r--r-- | gcc/fortran/trans-array.c | 34 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/actual_array_substr_1.f90 | 22 |
4 files changed, 65 insertions, 3 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 73b8f7e..39e0209 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2006-06-24 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/28118 + * trans-array.c (gfc_conv_expr_descriptor): When building temp, + use the substring reference to calculate the length if the + expression does not have a charlen. + 2006-06-24 Francois-Xavier Coudert <coudert@clipper.ens.fr> PR fortran/28094 diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 941e711..6a2c2de 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -4184,9 +4184,37 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) loop.temp_ss->next = gfc_ss_terminator; if (expr->ts.type == BT_CHARACTER) { - if (expr->ts.cl - && expr->ts.cl->length - && expr->ts.cl->length->expr_type == EXPR_CONSTANT) + if (expr->ts.cl == NULL) + { + /* This had better be a substring reference! */ + gfc_ref *char_ref = expr->ref; + for (; char_ref; char_ref = char_ref->next) + if (char_ref->type == REF_SUBSTRING) + { + mpz_t char_len; + expr->ts.cl = char_ref->u.ss.length; + mpz_init_set_ui (char_len, 1); + mpz_add (char_len, char_len, + char_ref->u.ss.end->value.integer); + mpz_sub (char_len, char_len, + char_ref->u.ss.start->value.integer); + expr->ts.cl->backend_decl + = gfc_conv_mpz_to_tree (char_len, + gfc_default_character_kind); + /* Cast is necessary for *-charlen refs. */ + expr->ts.cl->backend_decl + = convert (gfc_charlen_type_node, + expr->ts.cl->backend_decl); + mpz_clear (char_len); + break; + } + gcc_assert (char_ref != NULL); + loop.temp_ss->data.temp.type + = gfc_typenode_for_spec (&expr->ts); + loop.temp_ss->string_length = expr->ts.cl->backend_decl; + } + else if (expr->ts.cl->length + && expr->ts.cl->length->expr_type == EXPR_CONSTANT) { expr->ts.cl->backend_decl = gfc_conv_mpz_to_tree (expr->ts.cl->length->value.integer, diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 1c8e7c4..2db5a7c 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2006-06-24 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/28118 + * gfortran.dg/actual_array_substr_1.f90: New test. + 2006-06-24 Olivier Hainque <hainque@adacore.com> * gnat.dg/scalar_mode_agg_compare_loop.adb: New test. diff --git a/gcc/testsuite/gfortran.dg/actual_array_substr_1.f90 b/gcc/testsuite/gfortran.dg/actual_array_substr_1.f90 new file mode 100644 index 0000000..90108ec --- /dev/null +++ b/gcc/testsuite/gfortran.dg/actual_array_substr_1.f90 @@ -0,0 +1,22 @@ +! { dg-do run } +! Test fix of PR28118, in which a substring reference to an +! actual argument with an array reference would cause a segfault. +! +! Contributed by Paul Thomas <pault@gcc.gnu.org> +! +program gfcbug33
+ character(12) :: a(2) + a(1) = "abcdefghijkl" + a(2) = "mnopqrstuvwx" + call foo ((a(2:1:-1)(6:))) + call bar ((a(:)(7:11))) +contains + subroutine foo (chr) + character(7) :: chr(:) + if (chr(1)//chr(2) .ne. "rstuvwxfghijkl") call abort () + end subroutine foo
+ subroutine bar (chr) + character(*) :: chr(:) + if (trim(chr(1))//trim(chr(2)) .ne. "ghijkstuvw") call abort () + end subroutine bar
+end program gfcbug33
|