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: r240817

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 36855b858d7aebb32bd4ff137a36806851907a85..e019a5d26d9b3590adc503a6450820762763fa62 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-09-30  Steven G. Kargl  <kargl@gcc.gnu.org>
 
        Backport from trunk

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 185cbab91ca58855f121f850b0adbe1f0120f3fa..381b0602e31687f66bb6fccf2e853b83a1846ce0 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -8060,6 +8060,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;
@@ -11277,7 +11289,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 51b886b7a7a5d17050f199ff6f86b976b763b21a..7d71d00c1e8eb194b1635a919fc6687c2392ed31 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-09-30  Steven G. Kargl  <kargl@gcc.gnu.org>
 
        Backport from trunk

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