From: Steven G. Kargl <kargl@gcc.gnu.org>
Date: Wed, 5 Oct 2016 22:49:28 +0000 (+0000)
Subject: re PR fortran/58991 (ICE with associate and character string constant)
X-Git-Tag: releases/gcc-5.5.0~788
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=49c03dbc2c021c6c5957a7c297bece5e511863d0;p=thirdparty%2Fgcc.git

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 36855b858d7a..e019a5d26d9b 100644
--- 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 185cbab91ca5..381b0602e316 100644
--- 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 51b886b7a7a5..7d71d00c1e8e 100644
--- 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
index 000000000000..1558992004d1
--- /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