The problem is with substrings of allocatable string components of derived 
types.  The code seems to be trying to get the string length from typespec of 
the derived type variable instead of from the component.

The attached patch gets the component typespec from the reference chain.

I don't understand the code well enough to have 100% confidence in this patch, 
but it seems like a step in the right direction.

Index: ChangeLog
===================================================================
--- ChangeLog   (revision 226429)
+++ ChangeLog   (working copy)
@@ -1877,6 +1877,12 @@
        * interface.c (is_procptr_result): New function to check if an
        expression is a procedure-pointer result.
        (compare_actual_formal): Use it.
+
+2015_07_31
+
+       PR fortran/65766
+       * resolve.c (gfc_resolve_substring_charlen): Use typespec of string
+       component when resolving substring length
 ^L
 Copyright (C) 2015 Free Software Foundation, Inc.
 
Index: resolve.c
===================================================================
--- resolve.c   (revision 226429)
+++ resolve.c   (working copy)
@@ -4540,10 +4540,15 @@ gfc_resolve_substring_charlen (gfc_expr *e)
 {
   gfc_ref *char_ref;
   gfc_expr *start, *end;
+  gfc_typespec *ts = NULL;
 
   for (char_ref = e->ref; char_ref; char_ref = char_ref->next)
-    if (char_ref->type == REF_SUBSTRING)
-      break;
+    {
+      if (char_ref->type == REF_SUBSTRING)
+       break;
+      if (char_ref->type == REF_COMPONENT)
+       ts = &char_ref->u.c.component->ts;
+    }
 
   if (!char_ref)
     return;
@@ -4573,7 +4578,11 @@ gfc_resolve_substring_charlen (gfc_expr *e)
   if (char_ref->u.ss.end)
     end = gfc_copy_expr (char_ref->u.ss.end);
   else if (e->expr_type == EXPR_VARIABLE)
-    end = gfc_copy_expr (e->symtree->n.sym->ts.u.cl->length);
+    {
+      if (!ts)
+       ts = &e->symtree->n.sym->ts;
+      end = gfc_copy_expr (ts->u.cl->length);
+    }
   else
     end = NULL;

Attachment: substr_alloc_string_comp_1.f90
Description: Binary data

Reply via email to