Fortran: Add F2018 TEAM_NUMBER to coindexed expressions [PR98903]

Add missing parsing and code generation for a[..., TEAM_NUMBER=...] as
defined from F2015 onwards.  Because F2015 is not used as dedicated
standard in GFortran add it to the F2018 standard feature set.

	PR fortran/98903

gcc/fortran/ChangeLog:

	* array.cc (gfc_copy_array_ref): Copy team, team_type and stat.
	(match_team_or_stat): Match a single team(_number)= or stat=.
	(gfc_match_array_ref): Add switching to image_selector_parsing
	and error handling when indices come after named arguments.
	* coarray.cc (move_coarray_ref): Move also team_type.
	* expr.cc (gfc_free_ref_list): Free team and stat expression.
	(gfc_find_team_co): Find team or team_number in array-ref.
	* gfortran.h (enum gfc_array_ref_team_type): New enum to
	distinguish unset, team or team_number expression.
	(gfc_find_team_co): Default searching to team= expressions.
	* resolve.cc (resolve_array_ref): Check for type correctness of
	team(_number) and stats in coindices.
	* trans-array.cc (gfc_conv_array_ref): Ensure stat is cleared
	when fcoarray=single is used.
	* trans-intrinsic.cc (conv_stat_and_team): Including team_number
	in conversion.
	(gfc_conv_intrinsic_caf_get): Propagate team_number to ABI
	routine.
	(conv_caf_send_to_remote): Same.
	(conv_caf_sendget): Same.

gcc/testsuite/ChangeLog:

	* gfortran.dg/coarray/coindexed_2.f90: New test.
	* gfortran.dg/coarray/coindexed_3.f08: New test.
	* gfortran.dg/coarray/coindexed_4.f08: New test.

1 files changed, 122 insertions, 50 deletions

diff --git a/gcc/fortran/array.cc b/gcc/fortran/array.cc
index 841a0ac..fa177fa 100644
--- a/gcc/fortran/array.cc
+++ b/gcc/fortran/array.cc
@@ -51,6 +51,9 @@ gfc_copy_array_ref (gfc_array_ref *src)
       dest->stride[i] = gfc_copy_expr (src->stride[i]);
     }
 
+  dest->stat = gfc_copy_expr (src->stat);
+  dest->team = gfc_copy_expr (src->team);
+
   return dest;
 }
 
@@ -172,6 +175,76 @@ matched:
   return (saw_boz ? MATCH_ERROR : MATCH_YES);
 }
 
+/** Match one of TEAM=, TEAM_NUMBER= or STAT=.  */
+
+match
+match_team_or_stat (gfc_array_ref *ar)
+{
+  gfc_expr *tmp;
+  bool team_error = false;
+
+  if (gfc_match (" team = %e", &tmp) == MATCH_YES)
+    {
+      if (ar->team == NULL && ar->team_type == TEAM_UNSET)
+	{
+	  ar->team = tmp;
+	  ar->team_type = TEAM_TEAM;
+	}
+      else if (ar->team_type == TEAM_TEAM)
+	{
+	  gfc_error ("Duplicate TEAM= attribute in %C");
+	  return MATCH_ERROR;
+	}
+      else
+	team_error = true;
+    }
+  else if (gfc_match (" team_number = %e", &tmp) == MATCH_YES)
+    {
+      if (!gfc_notify_std (GFC_STD_F2018, "TEAM_NUMBER= not supported at %C"))
+	return MATCH_ERROR;
+      if (ar->team == NULL && ar->team_type == TEAM_UNSET)
+	{
+	  ar->team = tmp;
+	  ar->team_type = TEAM_NUMBER;
+	}
+      else if (ar->team_type == TEAM_NUMBER)
+	{
+	  gfc_error ("Duplicate TEAM_NUMBER= attribute in %C");
+	  return MATCH_ERROR;
+	}
+      else
+	team_error = true;
+    }
+  else if (gfc_match (" stat = %e", &tmp) == MATCH_YES)
+    {
+      if (ar->stat == NULL)
+	{
+	  if (gfc_is_coindexed (tmp))
+	    {
+	      gfc_error ("Expression in STAT= at %C must not be coindexed");
+	      gfc_free_expr (tmp);
+	      return MATCH_ERROR;
+	    }
+	  ar->stat = tmp;
+	}
+      else
+	{
+	  gfc_error ("Duplicate STAT= attribute in %C");
+	  return MATCH_ERROR;
+	}
+    }
+  else
+    return MATCH_NO;
+
+  if (ar->team && team_error)
+    {
+      gfc_error ("Only one of TEAM= or TEAM_NUMBER= may appear in a "
+		 "coarray reference at %C");
+      return MATCH_ERROR;
+    }
+
+  return MATCH_YES;
+}
 
 /* Match an array reference, whether it is the whole array or particular
    elements or a section.  If init is set, the reference has to consist
@@ -183,9 +256,6 @@ gfc_match_array_ref (gfc_array_ref *ar, gfc_array_spec *as, int init,
 {
   match m;
   bool matched_bracket = false;
-  gfc_expr *tmp;
-  bool stat_just_seen = false;
-  bool team_just_seen = false;
 
   memset (ar, '\0', sizeof (*ar));
 
@@ -272,65 +342,24 @@ coarray:
 	return MATCH_ERROR;
     }
 
-  ar->stat = NULL;
+  ar->team_type = TEAM_UNSET;
 
-  for (ar->codimen = 0; ar->codimen + ar->dimen < GFC_MAX_DIMENSIONS; ar->codimen++)
+  for (ar->codimen = 0; ar->codimen + ar->dimen < GFC_MAX_DIMENSIONS;
+       ar->codimen++)
     {
       m = match_subscript (ar, init, true);
       if (m == MATCH_ERROR)
 	return MATCH_ERROR;
 
-      team_just_seen = false;
-      stat_just_seen = false;
-      if (gfc_match (" , team = %e", &tmp) == MATCH_YES && ar->team == NULL)
-	{
-	  ar->team = tmp;
-	  team_just_seen = true;
-	}
-
-      if (ar->team && !team_just_seen)
-	{
-	  gfc_error ("TEAM= attribute in %C misplaced");
-	  return MATCH_ERROR;
-	}
-
-      if (gfc_match (" , stat = %e",&tmp) == MATCH_YES && ar->stat == NULL)
-	{
-	  ar->stat = tmp;
-	  stat_just_seen = true;
-	}
-
-      if (ar->stat && !stat_just_seen)
-	{
-	  gfc_error ("STAT= attribute in %C misplaced");
-	  return MATCH_ERROR;
-	}
-
-      if (gfc_match_char (']') == MATCH_YES)
-	{
-	  ar->codimen++;
-	  if (ar->codimen < corank)
-	    {
-	      gfc_error ("Too few codimensions at %C, expected %d not %d",
-			 corank, ar->codimen);
-	      return MATCH_ERROR;
-	    }
-	  if (ar->codimen > corank)
-	    {
-	      gfc_error ("Too many codimensions at %C, expected %d not %d",
-			 corank, ar->codimen);
-	      return MATCH_ERROR;
-	    }
-	  return MATCH_YES;
-	}
-
       if (gfc_match_char (',') != MATCH_YES)
 	{
 	  if (gfc_match_char ('*') == MATCH_YES)
 	    gfc_error ("Unexpected %<*%> for codimension %d of %d at %C",
 		       ar->codimen + 1, corank);
 	  else
-	    gfc_error ("Invalid form of coarray reference at %C");
+	    {
+	      goto image_selector;
+	    }
 	  return MATCH_ERROR;
 	}
       else if (ar->dimen_type[ar->codimen + ar->dimen] == DIMEN_STAR)
@@ -340,6 +369,15 @@ coarray:
 	  return MATCH_ERROR;
 	}
 
+      m = match_team_or_stat (ar);
+      if (m == MATCH_ERROR)
+	return MATCH_ERROR;
+      else if (m == MATCH_YES)
+	goto image_selector;
+
+      if (gfc_match_char (']') == MATCH_YES)
+	goto rank_check;
+
       if (ar->codimen >= corank)
 	{
 	  gfc_error ("Invalid codimension %d at %C, only %d codimensions exist",
@@ -352,6 +390,40 @@ coarray:
 	     GFC_MAX_DIMENSIONS);
   return MATCH_ERROR;
 
+image_selector:
+  for (;;)
+    {
+      m = match_team_or_stat (ar);
+      if (m == MATCH_ERROR)
+	return MATCH_ERROR;
+
+      if (gfc_match_char (']') == MATCH_YES)
+	goto rank_check;
+
+      if (gfc_match_char (',') != MATCH_YES)
+	{
+	  gfc_error ("Invalid form of coarray reference at %C");
+	  return MATCH_ERROR;
+	}
+    }
+
+  return MATCH_ERROR;
+
+rank_check:
+  ar->codimen++;
+  if (ar->codimen < corank)
+    {
+      gfc_error ("Too few codimensions at %C, expected %d not %d", corank,
+		 ar->codimen);
+      return MATCH_ERROR;
+    }
+  if (ar->codimen > corank)
+    {
+      gfc_error ("Too many codimensions at %C, expected %d not %d", corank,
+		 ar->codimen);
+      return MATCH_ERROR;
+    }
+  return MATCH_YES;
 }