The attached patch fixes both PR fortran/58991 and fortran/58992.
The issue was that for a CHARACTER expression or variable as a
selector in an ASSOCIATE statement, the type-spec was incomplete.
That is, the actual length of the string was not set.  The patch
rectifies the problem (at least in my simple tests).

This patch also fixes the ICE for PR fortran/58618, but gfortran
then generates a wrong-code.  I don't have time to look into this
PR.  PR fortran/58618 may be considered fairly low hanging fruit
for the *lurkers* on the fortran@ list looking to get involved in
gfortran development.

Regression tested on x86_64-*-freebsd.  OK to commit?

PS:  There are still a number of issues with ASSOCIATE.  Help 
     fixing those issues would be welcomed.

PPS: Overloading resolve_assoc_var() for SELECT TYPE may have
     caused more issues than warranted.

2016-09-27  Steven G. Kargl  <kar...@gcc.gnu.org>

        PR fortran/58991
        PR fortran/58992
        * resolve.c (resolve_assoc_var):  Fix CHARACTER type-spec for a
        selector in ASSOCIATE.
        (resolve_fl_variable): Skip checks for an ASSOCIATE variable.

2016-09-27  Steven G. Kargl  <kar...@gcc.gnu.org>

        PR fortran/58991
        PR fortran/58992
        * gfortran.dg/associate_22.f90: New test.

-- 
Steve
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 240506)
+++ gcc/fortran/resolve.c	(working copy)
@@ -8304,6 +8304,18 @@ resolve_assoc_var (gfc_symbol* sym, bool
   /* Mark this as an associate variable.  */
   sym->attr.associate_var = 1;
 
+  /* Fix up the type-spec for CHARACTER types.  */
+  if (sym->ts.type == BT_CHARACTER && !sym->attr.select_type_temporary)
+    {
+      if (!sym->ts.u.cl)
+	sym->ts.u.cl = target->ts.u.cl;
+
+      if (!sym->ts.u.cl->length)
+	sym->ts.u.cl->length
+	  = gfc_get_int_expr (gfc_default_integer_kind,
+			      NULL, target->value.character.length);
+    }
+
   /* If the target is a good class object, so is the associate variable.  */
   if (sym->ts.type == BT_CLASS && gfc_expr_attr (target).class_ok)
     sym->attr.class_ok = 1;
@@ -11577,7 +11589,7 @@ resolve_fl_variable (gfc_symbol *sym, in
   if (!deferred_requirements (sym))
     return false;
 
-  if (sym->ts.type == BT_CHARACTER)
+  if (sym->ts.type == BT_CHARACTER && !sym->attr.associate_var)
     {
       /* Make sure that character string variables with assumed length are
 	 dummy arguments.  */
Index: gcc/testsuite/gfortran.dg/associate_22.f90
===================================================================
--- gcc/testsuite/gfortran.dg/associate_22.f90	(nonexistent)
+++ gcc/testsuite/gfortran.dg/associate_22.f90	(working copy)
@@ -0,0 +1,37 @@
+! { dg-do run }
+program foo
+
+   implicit none
+
+   character(len=4) :: s
+   character(len=10) :: a
+
+   ! This works.
+   s = 'abc'
+   associate(t => s)
+      if (trim(t) /= 'abc') call abort
+   end associate
+
+   ! This failed.
+   associate(u => 'abc')
+      if (trim(u) /= 'abc') call abort
+   end associate
+
+   ! This failed.
+   a = s // 'abc'
+   associate(v => s // 'abc')
+      if (trim(v) /= trim(a)) call abort
+   end associate
+
+   ! This failed.
+   a = trim(s) // 'abc'
+   associate(w => trim(s) // 'abc')
+      if (trim(w) /= trim(a)) call abort
+   end associate
+
+   ! This failed.
+   associate(x => trim('abc'))
+      if (trim(x) /= 'abc') call abort
+   end associate
+
+end program foo

Reply via email to