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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index f7156a1a9a0678c8d9e03aed20603809dfa3f461..2bab7b3110b8e0fbebecc43b4a7ff9eff663edc9 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+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

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index ddd9d742466ccc73bbfd95dd270d41c0859725fa..4645b57c78d01672c2fa1a40e7577e5af1e9bd72 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/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.  */

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 3d96a06609d38870affe6e89ed19223f29883b22..f2e83f838f44e4e6fe0d6aceeb694808982a85c3 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+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.

diff --git a/gcc/testsuite/gfortran.dg/associate_22.f90 b/gcc/testsuite/gfortran.dg/associate_22.f90
new file mode 100644 (file)
index 0000000..1558992
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_22.f90
@@ -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