This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

Re: [gfortran] Fix PR 17612: Correctly detect length of character-valued expressions


> 2004-09-24  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
>
>  PR fortran/17612
>  * trans-expr.c (gfc_get_expr_charlen): New function.
>  * trans.h (gfc_get_expr_charlen): Add prototype.
>  * trans-array.c (gfc_conv_expr_descriptor): Use gfc_get_expr_charlen
>  to determine string length. Update comment.

You missed another place where we should be calling gfc_get_expr_charlen.

The stuff to handle substrings feels wrong. Unfortunately subobjects of 
scalarized arrays are broken in other ways, so it's tricky to prove this.

I modified and applied as follows.
Tested on i686-linux.

Paul

Index: trans-array.c
===================================================================
RCS file: /var/cvsroot/gcc-cvs/gcc/gcc/fortran/trans-array.c,v
retrieving revision 1.27
diff -u -p -r1.27 trans-array.c
--- trans-array.c 16 Sep 2004 16:00:43 -0000 1.27
+++ trans-array.c 4 Oct 2004 12:42:54 -0000
@@ -3486,6 +3486,7 @@ gfc_conv_expr_descriptor (gfc_se * se, g
   tree offset;
   int full;
   gfc_ss *vss;
+  gfc_ref *ref;
 
   gcc_assert (ss != gfc_ss_terminator);
 
@@ -3528,23 +3529,42 @@ gfc_conv_expr_descriptor (gfc_se * se, g
  full = 0;
       else
  {
-   gcc_assert (info->ref->u.ar.type == AR_SECTION);
+   ref = info->ref;
+   gcc_assert (ref->u.ar.type == AR_SECTION);
 
    full = 1;
-   for (n = 0; n < info->ref->u.ar.dimen; n++)
+   for (n = 0; n < ref->u.ar.dimen; n++)
      {
        /* Detect passing the full array as a section.  This could do
           even more checking, but it doesn't seem worth it.  */
-       if (info->ref->u.ar.start[n]
-    || info->ref->u.ar.end[n]
-    || (info->ref->u.ar.stride[n]
-        && !gfc_expr_is_one (info->ref->u.ar.stride[n], 0)))
+       if (ref->u.ar.start[n]
+    || ref->u.ar.end[n]
+    || (ref->u.ar.stride[n]
+        && !gfc_expr_is_one (ref->u.ar.stride[n], 0)))
   {
     full = 0;
     break;
   }
      }
  }
+
+      /* Check for substring references.  */
+      ref = expr->ref;
+      if (!need_tmp && ref && expr->ts.type == BT_CHARACTER)
+ {
+   while (ref->next)
+     ref = ref->next;
+   if (ref->type == REF_SUBSTRING)
+     {
+       /* In general character substrings need a copy.  Character
+   array strides are expressed as multiples of the element
+   size (consistent with other array types), not in
+   characters.  */
+       full = 0;
+       need_tmp = 1;
+     }
+ }
+
       if (full)
  {
    if (se->direct_byref)
@@ -3562,8 +3582,10 @@ gfc_conv_expr_descriptor (gfc_se * se, g
      {
        se->expr = desc;
      }
+
    if (expr->ts.type == BT_CHARACTER)
-     se->string_length = expr->symtree->n.sym->ts.cl->backend_decl;
+     se->string_length = gfc_get_expr_charlen (expr);
+
    return;
  }
       break;
@@ -3634,7 +3656,7 @@ gfc_conv_expr_descriptor (gfc_se * se, g
       loop.temp_ss->type = GFC_SS_TEMP;
       loop.temp_ss->next = gfc_ss_terminator;
       loop.temp_ss->data.temp.type = gfc_typenode_for_spec (&expr->ts);
-      /* Which can hold our string, if present.  */
+      /* ... which can hold our string, if present.  */
       if (expr->ts.type == BT_CHARACTER)
  se->string_length = loop.temp_ss->string_length
    = TYPE_SIZE_UNIT (loop.temp_ss->data.temp.type);
@@ -3716,7 +3738,7 @@ gfc_conv_expr_descriptor (gfc_se * se, g
 
       /* Set the string_length for a character array.  */
       if (expr->ts.type == BT_CHARACTER)
- se->string_length = expr->symtree->n.sym->ts.cl->backend_decl;
+ se->string_length =  gfc_get_expr_charlen (expr);
 
       desc = info->descriptor;
       gcc_assert (secss && secss != gfc_ss_terminator);
Index: trans-expr.c
===================================================================
RCS file: /var/cvsroot/gcc-cvs/gcc/gcc/fortran/trans-expr.c,v
retrieving revision 1.29
diff -u -p -r1.29 trans-expr.c
--- trans-expr.c 24 Sep 2004 17:06:55 -0000 1.29
+++ trans-expr.c 4 Oct 2004 09:26:17 -0000
@@ -140,6 +140,53 @@ gfc_conv_expr_present (gfc_symbol * sym)
 }
 
 
+/* Get the character length of an expression, looking through gfc_refs
+   if necessary.  */
+
+tree
+gfc_get_expr_charlen (gfc_expr *e)
+{
+  gfc_ref *r;
+  tree length;
+
+  gcc_assert (e->expr_type == EXPR_VARIABLE 
+	      && e->ts.type == BT_CHARACTER);
+  
+  length = NULL; /* To silence compiler warning.  */
+
+  /* First candidate: if the variable is of type CHARACTER, the
+     expression's length could be the length of the character
+     variable. */
+  if (e->symtree->n.sym->ts.type == BT_CHARACTER)
+    length = e->symtree->n.sym->ts.cl->backend_decl;
+
+  /* Look through the reference chain for component references.  */
+  for (r = e->ref; r; r = r->next)
+    {
+      switch (r->type)
+ {
+ case REF_COMPONENT:
+   if (r->u.c.component->ts.type == BT_CHARACTER)
+     length = r->u.c.component->ts.cl->backend_decl;
+   break;
+
+ case REF_ARRAY:
+   /* Do nothing.  */
+   break;
+
+ default:
+   /* We should never got substring references here.  These will be
+      broken down by the scalarizer.  */
+   gcc_unreachable ();
+ }
+    }
+
+  gcc_assert (length != NULL);
+  return length;
+}
+
+  
+
 /* Generate code to initialize a string length variable. Returns the
    value.  */
 
Index: trans.h
===================================================================
RCS file: /var/cvsroot/gcc-cvs/gcc/gcc/fortran/trans.h,v
retrieving revision 1.18
diff -u -p -r1.18 trans.h
--- trans.h 16 Sep 2004 16:00:45 -0000 1.18
+++ trans.h 3 Oct 2004 15:48:14 -0000
@@ -316,6 +316,8 @@ tree gfc_conv_expr_present (gfc_symbol *
 
 /* Generate code to allocate a string temporary.  */
 tree gfc_conv_string_tmp (gfc_se *, tree, tree);
+/* Get the string length variable belonging to an expression.  */
+tree gfc_get_expr_charlen (gfc_expr *);
 /* Initialize a string length variable.  */
 void gfc_trans_init_string_length (gfc_charlen *, stmtblock_t *);
 


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]