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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index d9e7ec9577328c9a00973736247ec54beda6681c..b2a74525edefeee093636aeac352e285e5003abc 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2005-08-02  David Edelsohn  <edelsohn@gnu.org>
+
+       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  <jvdelisle@verizon.net>
 
        * intrinsic.texi: Add documentation for exponent, floor, and fnum and

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index a3a24b59f408273d0a98465773c1629eeb9a00aa..e36137110628c4159a7b5c378d2b603b9a9ed454 100644 (file)
--- 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: