Fortran: Various fixes on F2018 teams.

gcc/fortran/ChangeLog:

	* match.cc (match_exit_cycle): Allow to exit team block.
	(gfc_match_end_team): Create end_team node also without
	parameter list.
	* trans-intrinsic.cc (conv_stat_and_team): Team and team_number
	only need to be a single pointer.
	* trans-stmt.cc (trans_associate_var): Create a mapping coarray
	token for coarray associations or it is not addressed correctly.
	* trans.h (enum gfc_coarray_regtype): Add mapping mode to
	coarray register.

libgfortran/ChangeLog:

	* caf/libcaf.h: Add mapping mode to coarray's register.
	* caf/single.c (_gfortran_caf_register): Create a token sharing
	another token's memory.
	(check_team): Check team parameters to coindexed expressions are
	valid.

gcc/testsuite/ChangeLog:

	* gfortran.dg/coarray/coindexed_3.f08: Add minimal test for
	get_team().
	* gfortran.dg/team_change_2.f90: Add test for change team with
	label and exiting out of it.
	* gfortran.dg/team_end_2.f90: Check parsing to labeled team
	blocks is correct now.
	* gfortran.dg/team_end_3.f90: Check that end_team call is
	generated for labeled end_teams, too.
	* gfortran.dg/coarray/coindexed_5.f90: New test.

9 files changed, 137 insertions, 10 deletions

diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
index 0d81b69..474ba81 100644
--- a/gcc/fortran/match.cc
+++ b/gcc/fortran/match.cc
@@ -3325,6 +3325,7 @@ match_exit_cycle (gfc_statement st, gfc_exec_op op)
 
     case COMP_ASSOCIATE:
     case COMP_BLOCK:
+    case COMP_CHANGE_TEAM:
     case COMP_IF:
     case COMP_SELECT:
     case COMP_SELECT_TYPE:
@@ -4162,9 +4163,12 @@ gfc_match_end_team (void)
     goto done;
 
   if (gfc_match_char ('(') != MATCH_YES)
-    /* There could be a team-construct-name following.  Let caller decide
-       about error.  */
-    return MATCH_NO;
+    {
+      /* There could be a team-construct-name following.  Let caller decide
+	 about error.  */
+      new_st.op = EXEC_END_TEAM;
+      return MATCH_NO;
+    }
 
   for (;;)
     {
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index f388ba5..440cbdd 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -1183,7 +1183,7 @@ conv_stat_and_team (stmtblock_t *block, gfc_expr *expr, tree *stat, tree *team,
     {
       gfc_se team_se;
       gfc_init_se (&team_se, NULL);
-      gfc_conv_expr_reference (&team_se, team_e);
+      gfc_conv_expr (&team_se, team_e);
       *team
 	= gfc_build_addr_expr (NULL_TREE, gfc_trans_force_lval (&team_se.pre,
 								team_se.expr));
@@ -1198,7 +1198,7 @@ conv_stat_and_team (stmtblock_t *block, gfc_expr *expr, tree *stat, tree *team,
     {
       gfc_se team_se;
       gfc_init_se (&team_se, NULL);
-      gfc_conv_expr_reference (&team_se, team_e);
+      gfc_conv_expr (&team_se, team_e);
       *team_no = gfc_build_addr_expr (
 	NULL_TREE,
 	gfc_trans_force_lval (&team_se.pre,
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 11fc1a8..487b768 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -2056,6 +2056,30 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
 
       gfc_conv_expr_descriptor (&se, e);
 
+      if (flag_coarray == GFC_FCOARRAY_LIB && sym->attr.codimension)
+	{
+	  tree token = gfc_conv_descriptor_token (se.expr),
+	       size
+	       = sym->attr.dimension
+		   ? fold_build2 (MULT_EXPR, gfc_array_index_type,
+				  gfc_conv_descriptor_size (se.expr, e->rank),
+				  gfc_conv_descriptor_span_get (se.expr))
+		   : gfc_conv_descriptor_span_get (se.expr);
+	  /* Create a new token, because in the token the modified descriptor
+	     is stored.  The modified descriptor is needed for accesses on the
+	     remote image.  In the scalar case, the base address needs to be
+	     associated correctly, which also needs a new token.
+	     The token is freed automatically be the end team statement.  */
+	  gfc_add_expr_to_block (
+	    &se.pre,
+	    build_call_expr_loc (
+	      input_location, gfor_fndecl_caf_register, 7, size,
+	      build_int_cst (integer_type_node, GFC_CAF_COARRAY_MAP_EXISTING),
+	      gfc_build_addr_expr (pvoid_type_node, token),
+	      gfc_build_addr_expr (NULL_TREE, se.expr), null_pointer_node,
+	      null_pointer_node, integer_zero_node));
+	}
+
       if (sym->ts.type == BT_CHARACTER
 	  && !sym->attr.select_type_temporary
 	  && sym->ts.u.cl->backend_decl
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 13bb04a..461b0cd 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -139,10 +139,10 @@ enum gfc_coarray_regtype
   GFC_CAF_EVENT_STATIC,
   GFC_CAF_EVENT_ALLOC,
   GFC_CAF_COARRAY_ALLOC_REGISTER_ONLY,
-  GFC_CAF_COARRAY_ALLOC_ALLOCATE_ONLY
+  GFC_CAF_COARRAY_ALLOC_ALLOCATE_ONLY,
+  GFC_CAF_COARRAY_MAP_EXISTING
 };
 
-
 /* Describes the action to take on _caf_deregister.  Keep in sync with
    gcc/fortran/trans.h.  The negative values are not valid for the library and
    are used by the drivers for building the correct call.  */
diff --git a/gcc/testsuite/gfortran.dg/coarray/coindexed_3.f08 b/gcc/testsuite/gfortran.dg/coarray/coindexed_3.f08
index 29c2b3a..7fd2085 100644
--- a/gcc/testsuite/gfortran.dg/coarray/coindexed_3.f08
+++ b/gcc/testsuite/gfortran.dg/coarray/coindexed_3.f08
@@ -9,6 +9,7 @@ program pr98903
   integer :: a[*]
   type(team_type) :: team
 
+  team = get_team()
   me = this_image()
   n = num_images()
   a = 42
diff --git a/gcc/testsuite/gfortran.dg/coarray/coindexed_5.f90 b/gcc/testsuite/gfortran.dg/coarray/coindexed_5.f90
new file mode 100644
index 0000000..c35ec10
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/coindexed_5.f90
@@ -0,0 +1,80 @@
+!{ dg-do run }
+
+! Check coindexes with team= or team_number= are working.
+
+program coindexed_5
+  use, intrinsic :: iso_fortran_env
+
+  type(team_type) :: parentteam, team, formed_team
+  integer :: t_num= 42, stat = 42, lhs
+  integer(kind=2) :: st_num=42
+  integer :: caf(2)[*]
+
+  parentteam = get_team()
+
+  caf = [23, 32]
+  form team(t_num, team, new_index=1)
+  form team(t_num, formed_team)
+
+  change team(team, cell[*] => caf(2))
+    ! for get_from_remote
+    ! Checking against caf_single is very limitted.
+    if (cell[1, team_number=t_num] /= 32) stop 1
+    if (cell[1, team_number=st_num] /= 32) stop 2
+    if (cell[1, team=parentteam] /= 32) stop 3
+
+    ! Check that team_number is validated
+    lhs = cell[1, team_number=5, stat=stat]
+    if (stat /= 1) stop 4
+
+    ! Check that only access to active teams is valid
+    stat = 42
+    lhs = cell[1, team=formed_team, stat=stat]
+    if (stat /= 1) stop 5
+
+    ! for send_to_remote
+    ! Checking against caf_single is very limitted.
+    cell[1, team_number=t_num] = 45
+    if (cell /= 45) stop 11
+    cell[1, team_number=st_num] = 46
+    if (cell /= 46) stop 12
+    cell[1, team=parentteam] = 47
+    if (cell /= 47) stop 13
+
+    ! Check that team_number is validated
+    stat = -1
+    cell[1, team_number=5, stat=stat] = 0
+    if (stat /= 1) stop 14
+
+    ! Check that only access to active teams is valid
+    stat = 42
+    cell[1, team=formed_team, stat=stat] = -1
+    if (stat /= 1) stop 15
+
+    ! for transfer_between_remotes
+    ! Checking against caf_single is very limitted.
+    cell[1, team_number=t_num] = caf(1)[1, team_number=-1]
+    if (cell /= 23) stop 21
+    cell[1, team_number=st_num] = caf(2)[1, team_number=-1]
+    ! cell is an alias for caf(2) and has been overwritten by caf(1)!
+    if (cell /= 23) stop 22
+    cell[1, team=parentteam] = caf(1)[1, team= team]
+    if (cell /= 23) stop 23
+
+    ! Check that team_number is validated
+    stat = -1
+    cell[1, team_number=5, stat=stat] = caf(1)[1, team_number= -1]
+    if (stat /= 1) stop 24
+    stat = -1
+    cell[1, team_number=t_num] = caf(1)[1, team_number= -2, stat=stat]
+    if (stat /= 1) stop 25
+
+    ! Check that only access to active teams is valid
+    stat = 42
+    cell[1, team=formed_team, stat=stat] = caf(1)[1]
+    if (stat /= 1) stop 26
+    stat = 42
+    cell[1] = caf(1)[1, team=formed_team, stat=stat]
+    if (stat /= 1) stop 27
+  end team
+end program coindexed_5
diff --git a/gcc/testsuite/gfortran.dg/team_change_2.f90 b/gcc/testsuite/gfortran.dg/team_change_2.f90
index 00cc489..66fe63c 100644
--- a/gcc/testsuite/gfortran.dg/team_change_2.f90
+++ b/gcc/testsuite/gfortran.dg/team_change_2.f90
@@ -74,6 +74,13 @@
     continue
   end team !{ dg-error "Expecting END PROGRAM statement" }
 
+  t: change team(team)
+    exit t
+  end team t
+
+  change team(team)
+    exit t !{ dg-error "EXIT statement at \\(1\\) is not within construct 't'" }
+  end team
 contains
   subroutine foo(team)
     type(team_type) :: team
diff --git a/gcc/testsuite/gfortran.dg/team_end_2.f90 b/gcc/testsuite/gfortran.dg/team_end_2.f90
index 64f072a..c27b59d 100644
--- a/gcc/testsuite/gfortran.dg/team_end_2.f90
+++ b/gcc/testsuite/gfortran.dg/team_end_2.f90
@@ -29,5 +29,14 @@
   change team (team)
     continue
   end team (stat=istat, errmsg=err, errmsg=err) ! { dg-error "Duplicate ERRMSG" }
+
+  t: change team (team)
+    continue
+  end team (stat=istat) t ! ok
+
+  t2: change team (team)
+    continue
+  end team   ! { dg-error "Expected block name of 't2' in END TEAM" }
+  end team t2  ! close the team correctly to catch other errors
 end
 
diff --git a/gcc/testsuite/gfortran.dg/team_end_3.f90 b/gcc/testsuite/gfortran.dg/team_end_3.f90
index 5e004ad..9cd7d4c 100644
--- a/gcc/testsuite/gfortran.dg/team_end_3.f90
+++ b/gcc/testsuite/gfortran.dg/team_end_3.f90
@@ -29,10 +29,12 @@
   deallocate(sample, stat=istat)
   if (istat == 0) stop 6
 
-  change team (team)
+  istat = 42
+  t: change team (team)
     continue
-  end team (stat=istat, errmsg=err)
-  if (trim(err) /= 'unchanged') stop 7
+  end team (stat=istat, errmsg=err) t
+  if (istat /= 0) stop 7
+  if (trim(err) /= 'unchanged') stop 8
 end
 
 ! { dg-final { scan-tree-dump "_gfortran_caf_end_team \\(&istat, 0B, 0\\)" "original" } }