From c2fee3de3b9b15b903841cc1d6679a627ccbbebe Mon Sep 17 00:00:00 2001 From: David Edelsohn Date: Wed, 3 Aug 2005 01:55:37 +0000 Subject: [PATCH] re PR fortran/22491 (character array parameters do not reduce) PR fortran/22491 * expr.c (simplify_parameter_variable): Do not copy the subobject references if the expression value is a constant. * expr.c (gfc_simplify_expr): Evaluate constant substrings. From-SVN: r102676 --- gcc/fortran/ChangeLog | 8 ++++++++ gcc/fortran/expr.c | 26 ++++++++++++++++++++++++-- 2 files changed, 32 insertions(+), 2 deletions(-) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index d9e7ec957732..b2a74525edef 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2005-08-02 David Edelsohn + + PR fortran/22491 + * expr.c (simplify_parameter_variable): Do not copy the subobject + references if the expression value is a constant. + + * expr.c (gfc_simplify_expr): Evaluate constant substrings. + 2005-07-31 Jerry DeLisle * intrinsic.texi: Add documentation for exponent, floor, and fnum and diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index a3a24b59f408..e36137110628 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -1068,7 +1068,8 @@ simplify_parameter_variable (gfc_expr * p, int type) try t; e = gfc_copy_expr (p->symtree->n.sym->value); - if (p->ref) + /* Do not copy subobject refs for constant. */ + if (e->expr_type != EXPR_CONSTANT && p->ref != NULL) e->ref = copy_ref (p->ref); t = gfc_simplify_expr (e, type); @@ -1130,7 +1131,28 @@ gfc_simplify_expr (gfc_expr * p, int type) if (simplify_ref_chain (p->ref, type) == FAILURE) return FAILURE; - /* TODO: evaluate constant substrings. */ + if (gfc_is_constant_expr (p)) + { + char *s; + int start, end; + + gfc_extract_int (p->ref->u.ss.start, &start); + start--; /* Convert from one-based to zero-based. */ + gfc_extract_int (p->ref->u.ss.end, &end); + s = gfc_getmem (end - start + 1); + memcpy (s, p->value.character.string + start, end - start); + s[end] = '\0'; /* TODO: C-style string for debugging. */ + gfc_free (p->value.character.string); + p->value.character.string = s; + p->value.character.length = end - start; + p->ts.cl = gfc_get_charlen (); + p->ts.cl->next = gfc_current_ns->cl_list; + gfc_current_ns->cl_list = p->ts.cl; + p->ts.cl->length = gfc_int_expr (p->value.character.length); + gfc_free_ref_list (p->ref); + p->ref = NULL; + p->expr_type = EXPR_CONSTANT; + } break; case EXPR_OP: