re PR fortran/64933 (ASSOCIATE on a character variable does not allow substring expre...

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

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

diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index f26740d42ef7089ead6dbcd00b114051dc1f4d18..50d7072b67097d295d616f73e2cae7f81ba8e9e9 100644 (file)
--- a/gcc/fortran/primary.c
+++ b/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

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 4ca326b5759405f318b8b88f11a19017567b9ad1..3babf14777b021954986da4724588a6794207020 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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

diff --git a/gcc/testsuite/gfortran.dg/associate_23.f90 b/gcc/testsuite/gfortran.dg/associate_23.f90
new file mode 100644 (file)
index 0000000..b4d58ff
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_23.f90
@@ -0,0 +1,36 @@
+! { 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