This is the mail archive of the fortran@gcc.gnu.org mailing list for the GNU Fortran project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[PATCH] PR fortran/58991 and fortran/58992


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  <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-27  Steven G. Kargl  <kargls@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

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]