From d5551618259aa0add9a31cf9dcbb4810748ad7a5 Mon Sep 17 00:00:00 2001 From: Daniel Kraft Date: Thu, 4 Sep 2008 21:16:13 +0200 Subject: re PR fortran/37099 (Wrong results when comparing a character array to a character expression) 2008-09-04 Daniel Kraft * PR fortran/37099 * expr.c (simplify_const_ref): Update expression's character length when pulling out a substring reference. 2008-09-04 Daniel Kraft PR fortran/37099 * gfortran.dg/string_compare_1.f90: New text. * gfortran.dg/string_compare_2.f90: New text. * gfortran.dg/string_compare_3.f90: New text. From-SVN: r139997 --- gcc/fortran/ChangeLog | 6 ++++++ gcc/fortran/expr.c | 35 ++++++++++++++++++++++++++++++++++- 2 files changed, 40 insertions(+), 1 deletion(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 57ed95f..23dfbdf 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2008-09-04 Daniel Kraft + + * PR fortran/37099 + * expr.c (simplify_const_ref): Update expression's character length + when pulling out a substring reference. + 2008-09-04 Ian Lance Taylor * symbol.c (generate_isocbinding_symbol): Compare diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index b5a17c0..6ff6d10 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -1454,7 +1454,40 @@ simplify_const_ref (gfc_expr *p) for (; cons; cons = cons->next) { cons->expr->ref = gfc_copy_ref (p->ref->next); - simplify_const_ref (cons->expr); + if (simplify_const_ref (cons->expr) == FAILURE) + return FAILURE; + } + + /* If this is a CHARACTER array and we possibly took a + substring out of it, update the type-spec's character + length according to the first element (as all should have + the same length). */ + if (p->ts.type == BT_CHARACTER) + { + int string_len; + + gcc_assert (p->ref->next); + gcc_assert (!p->ref->next->next); + gcc_assert (p->ref->next->type == REF_SUBSTRING); + + if (p->value.constructor) + { + const gfc_expr* first = p->value.constructor->expr; + gcc_assert (first->expr_type == EXPR_CONSTANT); + gcc_assert (first->ts.type == BT_CHARACTER); + string_len = first->value.character.length; + } + else + string_len = 0; + + if (!p->ts.cl) + { + p->ts.cl = gfc_get_charlen (); + p->ts.cl->next = NULL; + p->ts.cl->length = NULL; + } + gfc_free_expr (p->ts.cl->length); + p->ts.cl->length = gfc_int_expr (string_len); } } gfc_free_ref_list (p->ref); -- cgit v1.1