re PR fortran/64933 (ASSOCIATE on a character variable does not allow substring expressions)

2016-04-19  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/64933
	* primary.c (gfc_match_varspec): If selector expression is
	unambiguously an array, make sure that the associate name
	is an array and has an array spec. Modify the original
	condition for doing this to exclude character types.

2016-04-19  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/64933
	* gfortran.dg/associate_23.f90: New test.

From-SVN: r241860

gcc/fortran/ChangeLog

+2016-04-19  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/64933
+	* primary.c (gfc_match_varspec): If selector expression is
+	unambiguously an array, make sure that the associate name
+	is an array and has an array spec. Modify the original
+	condition for doing this to exclude character types.
+
 2016-11-03  Fritz Reese <fritzoreese@gmail.com>
 
 	* gfortran.texi: Document.

gcc/fortran/primary.c

@@ -1931,15 +1931,36 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
     }
 
   /* For associate names, we may not yet know whether they are arrays or not.
-     Thus if we have one and parentheses follow, we have to assume that it
-     actually is one for now.  The final decision will be made at
-     resolution time, of course.  */
-  if (sym->assoc && gfc_peek_ascii_char () == '('
-      && !(sym->assoc->dangling && sym->assoc->st
+     If the selector expression is unambiguously an array; eg. a full array
+     or an array section, then the associate name must be an array and we can
+     fix it now. Otherwise, if parentheses follow and it is not a character
+     type, we have to assume that it actually is one for now.  The final
+     decision will be made at resolution, of course.  */
+  if (sym->assoc
+      && gfc_peek_ascii_char () == '('
+      && sym->ts.type != BT_CLASS
+      && !sym->attr.dimension)
+    {
+      if ((!sym->assoc->dangling
+	   && sym->assoc->target
+	   && sym->assoc->target->ref
+	   && sym->assoc->target->ref->type == REF_ARRAY
+	   && (sym->assoc->target->ref->u.ar.type == AR_FULL
+	       || sym->assoc->target->ref->u.ar.type == AR_SECTION))
+	  ||
+	   (!(sym->assoc->dangling || sym->ts.type == BT_CHARACTER)
+	    && sym->assoc->st
 	   && sym->assoc->st->n.sym
-	   && sym->assoc->st->n.sym->attr.dimension == 0)
-      && sym->ts.type != BT_CLASS)
+	    && sym->assoc->st->n.sym->attr.dimension == 0))
+	{
     sym->attr.dimension = 1;
+	  if (sym->as == NULL && sym->assoc
+	      && sym->assoc->st
+	      && sym->assoc->st->n.sym
+	      && sym->assoc->st->n.sym->as)
+	    sym->as = gfc_copy_array_spec (sym->assoc->st->n.sym->as);
+	}
+    }
 
   if ((equiv_flag && gfc_peek_ascii_char () == '(')
       || gfc_peek_ascii_char () == '[' || sym->attr.codimension

gcc/testsuite/ChangeLog

+2016-04-19  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/64933
+	* gfortran.dg/associate_23.f90: New test.
+
 2016-11-04  Jakub Jelinek  <jakub@redhat.com>
 
 	PR target/77834

gcc/testsuite/gfortran.dg/associate_23.f90

+! { dg-do run }
+!
+! Tests the fix for PR64933
+!
+! Contributed by Olivier Marsden  <olivier.marsden@ecmwf.int>
+!
+program test_this
+  implicit none
+  character(len = 15) :: char_var, char_var_dim (3)
+  character(len = 80) :: buffer
+
+! Original failing case reported in PR
+  ASSOCIATE(should_work=>char_var)
+    should_work = "test succesful"
+    write (buffer, *) should_work(5:14)
+  END ASSOCIATE
+
+  if (trim (buffer) .ne. "  succesful") call abort
+
+! Found to be failing during debugging
+  ASSOCIATE(should_work=>char_var_dim)
+    should_work = ["test SUCCESFUL", "test_SUCCESFUL", "test.SUCCESFUL"]
+    write (buffer, *) should_work(:)(5:14)
+  END ASSOCIATE
+
+  if (trim (buffer) .ne. "  SUCCESFUL_SUCCESFUL.SUCCESFUL") call abort
+
+! Found to be failing during debugging
+  ASSOCIATE(should_work=>char_var_dim(1:2))
+    should_work = ["test SUCCESFUL", "test_SUCCESFUL", "test.SUCCESFUL"]
+    write (buffer, *) should_work(:)(5:14)
+  END ASSOCIATE
+
+  if (trim (buffer) .ne. "  SUCCESFUL_SUCCESFUL") call abort
+
+end program