diff mbox

Possible patch for fortran/65766

Message ID 14ee3841008.118cb9da025894.3539198465438819909@zoho.com
State New
Headers show

Commit Message

Louis Krupp July 31, 2015, 9:49 a.m. UTC 
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.
diff mbox

Patch

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;