Fix parsing of substring refs in coarrays. [PR51815]

The parser was greadily taking the substring ref as an array ref because
an array_spec was present.  Fix this by only parsing the coarray (pseudo)
ref when no regular array is present.

gcc/fortran/ChangeLog:

	PR fortran/51815

	* array.cc (gfc_match_array_ref): Only parse coarray part of
	ref.
	* match.h (gfc_match_array_ref): Add flag.
	* primary.cc (gfc_match_varspec): Request only coarray ref
	parsing when no regular array is present.  Report error on
	unexpected additional ref.

gcc/testsuite/ChangeLog:

	* gfortran.dg/pr102532.f90: Fix dg-errors: Add new error.
	* gfortran.dg/coarray/substring_1.f90: New test.

5 files changed, 59 insertions, 20 deletions

diff --git a/gcc/fortran/array.cc b/gcc/fortran/array.cc
index 1fa61eb..ed8cb54 100644
--- a/gcc/fortran/array.cc
+++ b/gcc/fortran/array.cc
@@ -179,7 +179,7 @@ matched:
 
 match
 gfc_match_array_ref (gfc_array_ref *ar, gfc_array_spec *as, int init,
-		     int corank)
+		     int corank, bool coarray_only)
 {
   match m;
   bool matched_bracket = false;
@@ -198,6 +198,8 @@ gfc_match_array_ref (gfc_array_ref *ar, gfc_array_spec *as, int init,
        matched_bracket = true;
        goto coarray;
     }
+  else if (coarray_only && corank != 0)
+    goto coarray;
 
   if (gfc_match_char ('(') != MATCH_YES)
     {
@@ -243,11 +245,12 @@ gfc_match_array_ref (gfc_array_ref *ar, gfc_array_spec *as, int init,
 coarray:
   if (!matched_bracket && gfc_match_char ('[') != MATCH_YES)
     {
-      if (ar->dimen > 0)
+      int dim = coarray_only ? 0 : ar->dimen;
+      if (dim > 0 || coarray_only)
 	{
 	  if (corank != 0)
 	    {
-	      for (int i = ar->dimen; i < GFC_MAX_DIMENSIONS; ++i)
+	      for (int i = dim; i < GFC_MAX_DIMENSIONS; ++i)
 		ar->dimen_type[i] = DIMEN_THIS_IMAGE;
 	      ar->codimen = corank;
 	    }
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index 84d84b8..2c76afb 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -317,7 +317,8 @@ match gfc_match_init_expr (gfc_expr **);
 
 /* array.cc.  */
 match gfc_match_array_spec (gfc_array_spec **, bool, bool);
-match gfc_match_array_ref (gfc_array_ref *, gfc_array_spec *, int, int);
+match gfc_match_array_ref (gfc_array_ref *, gfc_array_spec *, int, int,
+			   bool = false);
 match gfc_match_array_constructor (gfc_expr **);
 
 /* interface.cc.  */
diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc
index 09add92..c11359a 100644
--- a/gcc/fortran/primary.cc
+++ b/gcc/fortran/primary.cc
@@ -2192,7 +2192,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
   bool intrinsic;
   bool inferred_type;
   locus old_loc;
-  char sep;
+  char peeked_char;
 
   tail = NULL;
 
@@ -2282,9 +2282,10 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
 	sym->ts.u.derived = tgt_expr->ts.u.derived;
     }
 
-  if ((inferred_type && !sym->as && gfc_peek_ascii_char () == '(')
-      || (equiv_flag && gfc_peek_ascii_char () == '(')
-      || gfc_peek_ascii_char () == '[' || sym->attr.codimension
+  peeked_char = gfc_peek_ascii_char ();
+  if ((inferred_type && !sym->as && peeked_char == '(')
+      || (equiv_flag && peeked_char == '(') || peeked_char == '['
+      || sym->attr.codimension
       || (sym->attr.dimension && sym->ts.type != BT_CLASS
 	  && !sym->attr.proc_pointer && !gfc_is_proc_ptr_comp (primary)
 	  && !(gfc_matching_procptr_assignment
@@ -2295,6 +2296,8 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
 	      || CLASS_DATA (sym)->attr.codimension)))
     {
       gfc_array_spec *as;
+      bool coarray_only = sym->attr.codimension && !sym->attr.dimension
+			  && sym->ts.type == BT_CHARACTER;
 
       tail = extend_ref (primary, tail);
       tail->type = REF_ARRAY;
@@ -2310,12 +2313,18 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
       else
 	as = sym->as;
 
-      m = gfc_match_array_ref (&tail->u.ar, as, equiv_flag,
-			       as ? as->corank : 0);
+      m = gfc_match_array_ref (&tail->u.ar, as, equiv_flag, as ? as->corank : 0,
+			       coarray_only);
       if (m != MATCH_YES)
 	return m;
 
       gfc_gobble_whitespace ();
+      if (coarray_only)
+	{
+	  primary->ts = sym->ts;
+	  goto check_substring;
+	}
+
       if (equiv_flag && gfc_peek_ascii_char () == '(')
 	{
 	  tail = extend_ref (primary, tail);
@@ -2333,14 +2342,13 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
     return MATCH_YES;
 
   /* With DEC extensions, member separator may be '.' or '%'.  */
-  sep = gfc_peek_ascii_char ();
+  peeked_char = gfc_peek_ascii_char ();
   m = gfc_match_member_sep (sym);
   if (m == MATCH_ERROR)
     return MATCH_ERROR;
 
   inquiry = false;
-  if (m == MATCH_YES && sep == '%'
-      && primary->ts.type != BT_CLASS
+  if (m == MATCH_YES && peeked_char == '%' && primary->ts.type != BT_CLASS
       && (primary->ts.type != BT_DERIVED || inferred_type))
     {
       match mm;
@@ -2453,7 +2461,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
            && m == MATCH_YES && !inquiry)
     {
       gfc_error ("Unexpected %<%c%> for nonderived-type variable %qs at %C",
-		 sep, sym->name);
+		 peeked_char, sym->name);
       return MATCH_ERROR;
     }
 
@@ -2484,7 +2492,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
 	  if (inquiry)
 	    sym = NULL;
 
-	  if (sep == '%')
+	  if (peeked_char == '%')
 	    {
 	      if (tmp)
 		{
@@ -2815,6 +2823,11 @@ check_substring:
 	  if (substring)
 	    primary->ts.u.cl = NULL;
 
+	  if (gfc_peek_ascii_char () == '(')
+	    {
+	      gfc_error_now ("Unexpected array/substring ref at %C");
+	      return MATCH_ERROR;
+	    }
 	  break;
 
 	case MATCH_NO:
diff --git a/gcc/testsuite/gfortran.dg/coarray/substring_1.f90 b/gcc/testsuite/gfortran.dg/coarray/substring_1.f90
new file mode 100644
index 0000000..3c3ddc7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/substring_1.f90
@@ -0,0 +1,16 @@
+!{ dg-do run }
+
+! Test PR51815 is fixed
+! Contributed by Bill Long  <longb ad cray dot com>
+
+PROGRAM pr51815
+   implicit none
+   character(10) :: s[*]
+   character(18) :: d = 'ABCDEFGHIJKLMNOPQR'
+   integer       :: img
+
+   img = this_image()
+   s = d(img:img+9)
+   if (img == 1 .and. s(2:4) /= 'BCD') stop 1
+END PROGRAM
+
diff --git a/gcc/testsuite/gfortran.dg/pr102532.f90 b/gcc/testsuite/gfortran.dg/pr102532.f90
index 714379a..cc6e2e9 100644
--- a/gcc/testsuite/gfortran.dg/pr102532.f90
+++ b/gcc/testsuite/gfortran.dg/pr102532.f90
@@ -5,12 +5,18 @@
 !
 subroutine foo
    character(:), allocatable :: x[:]
-   associate (y => x(:)(2:)) ! { dg-error "Rank mismatch|deferred type parameter" }
-   end associate
+   character(:), dimension(:), allocatable :: c[:]
+   associate (y => x(:)(2:)) ! { dg-error "Unexpected array/substring ref|Invalid association target" }
+   end associate ! { dg-error "Expecting END SUBROUTINE" }
+   associate (a => c(:)(:)(2:)) ! { dg-error "Unexpected array/substring ref|Invalid association target" }
+   end associate ! { dg-error "Expecting END SUBROUTINE" }
 end
 
 subroutine bar
    character(:), allocatable :: x[:]
-   associate (y => x(:)(:)) ! { dg-error "Rank mismatch|deferred type parameter" }
-   end associate
-end
\ No newline at end of file
+   character(:), allocatable :: c
+   
+   associate (y => x(:)(:)) ! { dg-error "Unexpected array/substring ref|Invalid association target" }
+   end associate ! { dg-error "Expecting END SUBROUTINE" }
+   c = x(:)(2:5) ! { dg-error "Unexpected array/substring ref" }
+end