re PR fortran/58991 (ICE with associate and character string constant)

2016-10-05  Steven G. Kargl  <kargls@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-10-05  Steven G. Kargl  <kargls@gcc.gnu.org>

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

From-SVN: r240812

gcc/fortran/ChangeLog

+2016-10-05  Steven G. Kargl  <kargls@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-10-05  Fritz Reese  <fritzoreese@gmail.com>
 
 	* interface.c (gfc_compare_types): Don't compare BT_UNION components

gcc/fortran/resolve.c

@@ -8304,6 +8304,18 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
   /* 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, int mp_flag)
   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.  */

gcc/testsuite/ChangeLog

+2016-10-05  Steven G. Kargl  <kargls@gcc.gnu.org>
+
+	PR fortran/58991
+	PR fortran/58992
+	* gfortran.dg/associate_22.f90: New test.
+
 2016-10-05  Fritz Reese  <fritzoreese@gmail.com>
 
 	* gfortran.dg/dec_union_9.f90: New testcase.

gcc/testsuite/gfortran.dg/associate_22.f90

+! { 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