fortran: Testing patches for coarray shared memory.

	pr88076_v2_1.patch
	pr88076_v2_2.patch
	pr88076_v2_3.patch
	pr88076_v2_4.patch
	pr88076_v2_5.patch
	pr88076_v2_6.patch
	coarray_fixes_2.patch

	PR fortran/88076

gcc/fortran/ChangeLog:

	* check.cc (gfc_check_image_status): Modify
	(gfc_check_failed_or_stopped_images): Modify
	* coarray.cc (check_add_new_component): Modify
	* invoke.texi: Modify
	* trans-decl.cc (gfc_build_builtin_function_decls): Modify
	* trans-expr.cc (get_scalar_to_descriptor_type): Modify
	(copy_coarray_desc_part): Modify
	(gfc_class_array_data_assign): Modify
	(gfc_conv_derived_to_class): Modify
	* trans-intrinsic.cc (conv_intrinsic_image_status): Modify
	* trans-stmt.cc (gfc_trans_sync): Modify

libgfortran/ChangeLog:

	* Makefile.am: Modify
	* Makefile.in: Modify
	* caf/libcaf.h (LIBCAF_H): Modify
	(_gfortran_caf_failed_images): Modify
	(_gfortran_caf_image_status): Modify
	(_gfortran_caf_stopped_images): Modify
	* caf/single.c (caf_internal_error): Modify
	* caf/caf_error.c: New file.
	* caf/caf_error.h: New file.
	* caf/shmem.c: New file.
	* caf/shmem/alloc.c: New file.
	* caf/shmem/alloc.h: New file.
	* caf/shmem/allocator.c: New file.
	* caf/shmem/allocator.h: New file.
	* caf/shmem/collective_subroutine.c: New file.
	* caf/shmem/collective_subroutine.h: New file.
	* caf/shmem/counter_barrier.c: New file.
	* caf/shmem/counter_barrier.h: New file.
	* caf/shmem/hashmap.c: New file.
	* caf/shmem/hashmap.h: New file.
	* caf/shmem/shared_memory.c: New file.
	* caf/shmem/shared_memory.h: New file.
	* caf/shmem/supervisor.c: New file.
	* caf/shmem/supervisor.h: New file.
	* caf/shmem/sync.c: New file.
	* caf/shmem/sync.h: New file.
	* caf/shmem/teams_mgmt.c: New file.
	* caf/shmem/teams_mgmt.h: New file.
	* caf/shmem/thread_support.c: New file.
	* caf/shmem/thread_support.h: New file.

gcc/testsuite/ChangeLog:

	* gfortran.dg/coarray/alloc_comp_4.f90: Modify
	* gfortran.dg/coarray/atomic_2.f90: Modify
	* gfortran.dg/coarray/caf.exp: Modify
	* gfortran.dg/coarray/coarray_allocated.f90: Modify
	* gfortran.dg/coarray/coindexed_1.f90: Modify
	* gfortran.dg/coarray/coindexed_3.f08: Modify
	* gfortran.dg/coarray/coindexed_5.f90: Modify
	* gfortran.dg/coarray/dummy_3.f90: Modify
	* gfortran.dg/coarray/event_1.f90: Modify
	* gfortran.dg/coarray/event_3.f08: Modify
	* gfortran.dg/coarray/event_4.f08: Modify
	* gfortran.dg/coarray/failed_images_1.f08: Modify
	* gfortran.dg/coarray/failed_images_2.f08: Modify
	* gfortran.dg/coarray/image_status_1.f08: Modify
	* gfortran.dg/coarray/image_status_2.f08: Modify
	* gfortran.dg/coarray/lock_2.f90: Modify
	* gfortran.dg/coarray/poly_run_3.f90: Modify
	* gfortran.dg/coarray/scalar_alloc_1.f90: Modify
	* gfortran.dg/coarray/stopped_images_1.f08: Modify
	* gfortran.dg/coarray/stopped_images_2.f08: Modify
	* gfortran.dg/coarray/sync_1.f90: Modify
	* gfortran.dg/coarray/sync_3.f90: Modify
	* gfortran.dg/coarray_sync_memory.f90: Modify
	* gfortran.dg/coarray/co_reduce_string.f90: New test.
	* gfortran.dg/coarray/sync_team.f90: New test.

32 files changed, 638 insertions, 191 deletions

diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index 838d523..3446c88 100644
--- a/gcc/fortran/check.cc
+++ b/gcc/fortran/check.cc
@@ -1835,7 +1835,7 @@ gfc_check_image_status (gfc_expr *image, gfc_expr *team)
       || !positive_check (0, image))
     return false;
 
-  return !team || (scalar_check (team, 0) && team_type_check (team, 0));
+  return !team || (scalar_check (team, 1) && team_type_check (team, 1));
 }
 
 
@@ -1878,13 +1878,8 @@ gfc_check_f_c_string (gfc_expr *string, gfc_expr *asis)
 bool
 gfc_check_failed_or_stopped_images (gfc_expr *team, gfc_expr *kind)
 {
-  if (team)
-    {
-      gfc_error ("%qs argument of %qs intrinsic at %L not yet supported",
-		 gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic,
-		 &team->where);
-      return false;
-    }
+  if (team && (!scalar_check (team, 0) || !team_type_check (team, 0)))
+    return false;
 
   if (kind)
     {
diff --git a/gcc/fortran/coarray.cc b/gcc/fortran/coarray.cc
index ef8fd4e..c611b53 100644
--- a/gcc/fortran/coarray.cc
+++ b/gcc/fortran/coarray.cc
@@ -696,17 +696,23 @@ check_add_new_component (gfc_symbol *type, gfc_expr *e, gfc_symbol *add_data)
 	    check_add_new_component (type, actual->expr, add_data);
 	  break;
 	case EXPR_FUNCTION:
-	  if (!e->symtree->n.sym->attr.pure
-	      && !e->symtree->n.sym->attr.elemental
-	      && !(e->value.function.isym
-		   && (e->value.function.isym->pure
-		       || e->value.function.isym->elemental)))
-	    /* Treat non-pure/non-elemental functions.  */
-	    check_add_new_comp_handle_array (e, type, add_data);
+	  if ((e->symtree->n.sym->attr.pure
+	       && e->symtree->n.sym->attr.elemental)
+	      || (e->value.function.isym && e->value.function.isym->pure
+		  && e->value.function.isym->elemental))
+	    {
+	      /* Only allow pure and elemental function calls in a coarray
+		 accessor, because all other may have side effects or access
+		 pointers, which may not be possible in the accessor running on
+		 another host.  */
+	      for (gfc_actual_arglist *actual = e->value.function.actual;
+		   actual; actual = actual->next)
+		check_add_new_component (type, actual->expr, add_data);
+	    }
 	  else
-	    for (gfc_actual_arglist *actual = e->value.function.actual; actual;
-		 actual = actual->next)
-	      check_add_new_component (type, actual->expr, add_data);
+	    /* Extract the expression, evaluate it and add a temporary with its
+	       value to the helper structure.  */
+	    check_add_new_comp_handle_array (e, type, add_data);
 	  break;
 	case EXPR_VARIABLE:
 	    check_add_new_comp_handle_array (e, type, add_data);
diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi
index 0b893e8..77926fa 100644
--- a/gcc/fortran/invoke.texi
+++ b/gcc/fortran/invoke.texi
@@ -104,6 +104,7 @@ one is not the default.
 * Interoperability Options::  Options for interoperability with other
                               languages.
 * Environment Variables:: Environment variables that affect @command{gfortran}.
+* Shared Memory Coarrays:: Multi process shared memory coarray support.
 @end menu
 
 @node Option Summary
@@ -2280,3 +2281,56 @@ variables.
 @xref{Runtime}, for environment variables that affect the
 run-time behavior of programs compiled with GNU Fortran.
 @c man end
+
+@node Shared Memory Coarrays
+@section Shared Memory Coarrays
+
+@c man begin SHARED MEMORY COARRAYS
+
+@command{gfortran} supplies a runtime library for running coarray enabled
+programs using a shared memory multi process approach.  The library is supplied
+as a static link library with the @command{libgfortran} library and is fully
+compatible with the ABI enabled when @command{gfortran} is called with
+@code{-fcoarray=lib}.  The shared memory coarray library then just needs to be
+linked to the executable produced by @command{gfortran} using
+@code{-lcaf_shmem}.
+
+The library @code{caf_shmem} can only be used on architectures that allow
+multiple processes to use the same memory at the same virtual memory address in
+each process' memory space.  This is the case on most Unix and Windows based
+systems.
+
+The resulting executable can be started without any driver and does not provide
+any additional command line options.  Limited control is possible by
+environment variables:
+
+@env{GFORTRAN_NUM_IMAGES}: The number of images to spawn when running the
+executable.  Note, there will always be one additional supervisor process, which
+does not participate in the computation, but is only responsible for starting
+the images and catching any (ab-)normal termination.  When the environment
+variable is not set, then the number of hardware threads reported by the OS will
+be taken. Over-provisioning is possible.  The number of images is limited only
+by the OS and the size of an integer variable on the architecture the program is
+to be run on.
+
+@env{GFORTRAN_SHARED_MEMORY_SIZE}: The size of the shared memory segment made
+available to all images is fixed and needs to be set at program start.  It can
+not grow or shrink.  The size can be given in bytes (no suffix), kilobytes
+(@code{k} or @code{K} suffix), megabytes (@code{m} or @code{M}) or gigabytes
+(@code{g} or @code{G}).  If the variable is not set, or not parseable, then on
+32-bit architectures 2^28 bytes and on 64-bit 2^34 bytes are choosen.  Note,
+although the size is set, most modern systems do not allocate the memory at
+program start.  This allows to choose a shared memory size larger than available
+memory.
+
+Warning: Choosing a large shared memory size may produce large coredumps!
+
+The shared memory coarray library internally uses some additional environment
+variables, which will be overwritten without notice or may result in failure to
+start.  These are: @code{GFORTRAN_IMAGE_NUM}, @code{GFORTRAN_SHMEM_PID} and
+@code{GFORTRAN_SHMEM_BASE}.  It is strongly discouraged to use these variables.
+Special care needs to be taken, when one coarray program starts another coarray
+program as a child process.  In this case it is the spawning process'
+responsibility to remove above variables from the environment.
+
+@c man end
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 43bd7be..ba4a842 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -4223,10 +4223,9 @@ gfc_build_builtin_function_decls (void)
 	get_identifier (PREFIX ("caf_sync_team")), ". r w w w ", void_type_node,
 	4, pvoid_type_node, pint_type, pchar_type_node, size_type_node);
 
-      gfor_fndecl_caf_team_number
-      	= gfc_build_library_function_decl_with_spec (
-	    get_identifier (PREFIX("caf_team_number")), ". r ",
-      	    integer_type_node, 1, integer_type_node);
+      gfor_fndecl_caf_team_number = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX ("caf_team_number")), ". r ", integer_type_node,
+	1, pvoid_type_node);
 
       gfor_fndecl_caf_image_status = gfc_build_library_function_decl_with_spec (
 	get_identifier (PREFIX ("caf_image_status")), ". r r ",
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 082987f..d97d135 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -90,6 +90,8 @@ static tree
 get_scalar_to_descriptor_type (tree scalar, symbol_attribute attr)
 {
   enum gfc_array_kind akind;
+  tree *lbound = NULL, *ubound = NULL;
+  int codim = 0;
 
   if (attr.pointer)
     akind = GFC_ARRAY_POINTER_CONT;
@@ -100,8 +102,16 @@ get_scalar_to_descriptor_type (tree scalar, symbol_attribute attr)
 
   if (POINTER_TYPE_P (TREE_TYPE (scalar)))
     scalar = TREE_TYPE (scalar);
-  return gfc_get_array_type_bounds (TREE_TYPE (scalar), 0, 0, NULL, NULL, 1,
-				    akind, !(attr.pointer || attr.target));
+  if (TYPE_LANG_SPECIFIC (TREE_TYPE (scalar)))
+    {
+      struct lang_type *lang_specific = TYPE_LANG_SPECIFIC (TREE_TYPE (scalar));
+      codim = lang_specific->corank;
+      lbound = lang_specific->lbound;
+      ubound = lang_specific->ubound;
+    }
+  return gfc_get_array_type_bounds (TREE_TYPE (scalar), 0, codim, lbound,
+				    ubound, 1, akind,
+				    !(attr.pointer || attr.target));
 }
 
 tree
@@ -760,11 +770,43 @@ gfc_get_vptr_from_expr (tree expr)
   return NULL_TREE;
 }
 
+static void
+copy_coarray_desc_part (stmtblock_t *block, tree dest, tree src)
+{
+  tree src_type = TREE_TYPE (src);
+  if (TYPE_LANG_SPECIFIC (src_type) && TYPE_LANG_SPECIFIC (src_type)->corank)
+    {
+      struct lang_type *lang_specific = TYPE_LANG_SPECIFIC (src_type);
+      for (int c = 0; c < lang_specific->corank; ++c)
+	{
+	  int dim = lang_specific->rank + c;
+	  tree codim = gfc_rank_cst[dim];
+
+	  if (lang_specific->lbound[dim])
+	    gfc_conv_descriptor_lbound_set (block, dest, codim,
+					    lang_specific->lbound[dim]);
+	  else
+	    gfc_conv_descriptor_lbound_set (
+	      block, dest, codim, gfc_conv_descriptor_lbound_get (src, codim));
+	  if (dim + 1 < lang_specific->corank)
+	    {
+	      if (lang_specific->ubound[dim])
+		gfc_conv_descriptor_ubound_set (block, dest, codim,
+						lang_specific->ubound[dim]);
+	      else
+		gfc_conv_descriptor_ubound_set (
+		  block, dest, codim,
+		  gfc_conv_descriptor_ubound_get (src, codim));
+	    }
+	}
+    }
+}
+
 void
 gfc_class_array_data_assign (stmtblock_t *block, tree lhs_desc, tree rhs_desc,
 			     bool lhs_type)
 {
-  tree tmp, tmp2, type;
+  tree lhs_dim, rhs_dim, type;
 
   gfc_conv_descriptor_data_set (block, lhs_desc,
 				gfc_conv_descriptor_data_get (rhs_desc));
@@ -775,15 +817,18 @@ gfc_class_array_data_assign (stmtblock_t *block, tree lhs_desc, tree rhs_desc,
 		  gfc_conv_descriptor_dtype (rhs_desc));
 
   /* Assign the dimension as range-ref.  */
-  tmp = gfc_get_descriptor_dimension (lhs_desc);
-  tmp2 = gfc_get_descriptor_dimension (rhs_desc);
+  lhs_dim = gfc_get_descriptor_dimension (lhs_desc);
+  rhs_dim = gfc_get_descriptor_dimension (rhs_desc);
+
+  type = lhs_type ? TREE_TYPE (lhs_dim) : TREE_TYPE (rhs_dim);
+  lhs_dim = build4_loc (input_location, ARRAY_RANGE_REF, type, lhs_dim,
+			gfc_index_zero_node, NULL_TREE, NULL_TREE);
+  rhs_dim = build4_loc (input_location, ARRAY_RANGE_REF, type, rhs_dim,
+			gfc_index_zero_node, NULL_TREE, NULL_TREE);
+  gfc_add_modify (block, lhs_dim, rhs_dim);
 
-  type = lhs_type ? TREE_TYPE (tmp) : TREE_TYPE (tmp2);
-  tmp = build4_loc (input_location, ARRAY_RANGE_REF, type, tmp,
-		    gfc_index_zero_node, NULL_TREE, NULL_TREE);
-  tmp2 = build4_loc (input_location, ARRAY_RANGE_REF, type, tmp2,
-		     gfc_index_zero_node, NULL_TREE, NULL_TREE);
-  gfc_add_modify (block, tmp, tmp2);
+  /* The corank dimensions are not copied by the ARRAY_RANGE_REF.  */
+  copy_coarray_desc_part (block, lhs_desc, rhs_desc);
 }
 
 /* Takes a derived type expression and returns the address of a temporary
@@ -899,6 +944,7 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym,
 						    gfc_expr_attr (e));
 	      gfc_add_modify (&parmse->pre, gfc_conv_descriptor_dtype (ctree),
 			      gfc_get_dtype (type));
+	      copy_coarray_desc_part (&parmse->pre, ctree, parmse->expr);
 	      if (optional)
 		parmse->expr = build3_loc (input_location, COND_EXPR,
 					   TREE_TYPE (parmse->expr),
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index be98427..7cd95da 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -2073,9 +2073,13 @@ conv_intrinsic_image_status (gfc_se *se, gfc_expr *expr)
 					    GFC_STAT_STOPPED_IMAGE));
     }
   else if (flag_coarray == GFC_FCOARRAY_LIB)
+    /* The team is optional and therefore needs to be a pointer to the opaque
+       pointer.  */
     tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_image_status, 2,
 			       args[0],
-			       num_args < 2 ? null_pointer_node : args[1]);
+			       num_args < 2
+				 ? null_pointer_node
+				 : gfc_build_addr_expr (NULL_TREE, args[1]));
   else
     gcc_unreachable ();
 
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index f105401..eadd40c 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -1362,7 +1362,8 @@ gfc_trans_sync (gfc_code *code, gfc_exec_op type)
     {
       gfc_init_se (&argse, NULL);
       gfc_conv_expr_val (&argse, code->expr1);
-      images = argse.expr;
+      images = gfc_trans_force_lval (&argse.pre, argse.expr);
+      gfc_add_block_to_block (&se.pre, &argse.pre);
     }
 
   if (code->expr2)
@@ -1372,6 +1373,7 @@ gfc_trans_sync (gfc_code *code, gfc_exec_op type)
       gfc_init_se (&argse, NULL);
       gfc_conv_expr_val (&argse, code->expr2);
       stat = argse.expr;
+      gfc_add_block_to_block (&se.pre, &argse.pre);
     }
   else
     stat = null_pointer_node;
@@ -1384,8 +1386,9 @@ gfc_trans_sync (gfc_code *code, gfc_exec_op type)
       argse.want_pointer = 1;
       gfc_conv_expr (&argse, code->expr3);
       gfc_conv_string_parameter (&argse);
-      errmsg = gfc_build_addr_expr (NULL, argse.expr);
+      errmsg = argse.expr;
       errmsglen = fold_convert (size_type_node, argse.string_length);
+      gfc_add_block_to_block (&se.pre, &argse.pre);
     }
   else if (flag_coarray == GFC_FCOARRAY_LIB)
     {
diff --git a/gcc/testsuite/gfortran.dg/coarray/alloc_comp_4.f90 b/gcc/testsuite/gfortran.dg/coarray/alloc_comp_4.f90
index 2ee8ff0..50b4bab 100644
--- a/gcc/testsuite/gfortran.dg/coarray/alloc_comp_4.f90
+++ b/gcc/testsuite/gfortran.dg/coarray/alloc_comp_4.f90
@@ -11,11 +11,19 @@ program main
   end type
 
   type(mytype), save :: object[*]
-  integer :: me
+  integer :: me, other
 
   me=this_image()
-  allocate(object%indices(me))
-  object%indices = 42
+  other = me + 1
+  if (other .GT. num_images()) other = 1
+  if (me == num_images()) then
+     allocate(object%indices(me/2))
+  else
+    allocate(object%indices(me))
+  end if
+  object%indices = 42 * me
 
-  if ( any( object[me]%indices(:) /= 42 ) ) STOP 1
+  sync all
+  if ( any( object[other]%indices(:) /= 42 * other ) ) STOP 1
+  sync all
 end program
diff --git a/gcc/testsuite/gfortran.dg/coarray/atomic_2.f90 b/gcc/testsuite/gfortran.dg/coarray/atomic_2.f90
index 5e1c496..7eccd7b 100644
--- a/gcc/testsuite/gfortran.dg/coarray/atomic_2.f90
+++ b/gcc/testsuite/gfortran.dg/coarray/atomic_2.f90
@@ -61,7 +61,7 @@ end do
 sync all
 
 call atomic_ref(var, caf[num_images()], stat=stat)
-if (stat /= 0 .or. var /= num_images() + this_image()) STOP 12
+if (stat /= 0 .or. var /= num_images() * 2) STOP 12
 do i = 1, num_images()
   call atomic_ref(var, caf[i], stat=stat)
   if (stat /= 0 .or. var /= num_images() + i) STOP 13
@@ -328,7 +328,7 @@ end do
 sync all
 
 call atomic_ref(var, caf[num_images()], stat=stat)
-if (stat /= 0 .or. var /= num_images() + this_image()) STOP 45
+if (stat /= 0 .or. var /= num_images() * 2) STOP 45
 do i = 1, num_images()
   call atomic_ref(var, caf[i], stat=stat)
   if (stat /= 0 .or. var /= num_images() + i) STOP 46
@@ -403,7 +403,7 @@ if (this_image() < storage_size(caf)-2) then
   do i = this_image(), min(num_images(), storage_size(caf)-2)
     var = -99
     call atomic_fetch_and(caf[i], shiftl(1, this_image()), var, stat=stat)
-    if (stat /= 0 .or. var <= 0) STOP 53
+    if (stat /= 0) STOP 53
   end do
 end if
 sync all
@@ -544,7 +544,7 @@ if (this_image() < storage_size(caf)-2) then
   do i = this_image(), min(num_images(), storage_size(caf)-2)
     var = -99
     call atomic_fetch_xor(caf[i], shiftl(1, this_image()), var, stat=stat)
-    if (stat /= 0 .or. (var < 0 .and. var /= -1)) STOP 68
+    if (stat /= 0) STOP 68
   end do
 end if
 sync all
@@ -628,26 +628,27 @@ sync all
 
 if (this_image() == 1) then
   call atomic_cas(caf_log[num_images()], compare=.false., new=.false., old=var2, stat=stat)
-  if (stat /= 0 .or. var2 .neqv. .true.) STOP 82
+  if (stat /= 0 .or. (var2 .neqv. .true.)) STOP 82
   call atomic_ref(var2, caf_log[num_images()], stat=stat)
-  if (stat /= 0 .or. var2 .neqv. .true.) STOP 83
+  if (stat /= 0 .or. (var2 .neqv. .true.)) STOP 83
 end if
 sync all
 
-if (this_image() == num_images() .and. caf_log .neqv. .true.) STOP 84
+if (this_image() == num_images() .and. (caf_log .neqv. .true.)) STOP 84
 call atomic_ref(var2, caf_log[num_images()], stat=stat)
-if (stat /= 0 .or. var2 .neqv. .true.) STOP 85
+if (stat /= 0 .or. (var2 .neqv. .true.)) STOP 85
 sync all
 
 if (this_image() == 1) then
   call atomic_cas(caf_log[num_images()], compare=.true., new=.false., old=var2, stat=stat)
-  if (stat /= 0 .or. var2 .neqv. .true.) STOP 86
+  if (stat /= 0 .or. (var2 .neqv. .true.)) STOP 86
   call atomic_ref(var2, caf_log[num_images()], stat=stat)
-  if (stat /= 0 .or. var2 .neqv. .false.) STOP 87
+  if (stat /= 0 .or. (var2 .neqv. .false.)) STOP 87
 end if
 sync all
 
-if (this_image() == num_images() .and. caf_log .neqv. .false.) STOP 88
+if (this_image() == num_images() .and. (caf_log .neqv. .false.)) STOP 88
 call atomic_ref(var2, caf_log[num_images()], stat=stat)
-if (stat /= 0 .or. var2 .neqv. .false.) STOP 89
+if (stat /= 0 .or. (var2 .neqv. .false.)) STOP 89
+sync all
 end
diff --git a/gcc/testsuite/gfortran.dg/coarray/caf.exp b/gcc/testsuite/gfortran.dg/coarray/caf.exp
index c1e8e8c..1f002e0 100644
--- a/gcc/testsuite/gfortran.dg/coarray/caf.exp
+++ b/gcc/testsuite/gfortran.dg/coarray/caf.exp
@@ -70,6 +70,12 @@ proc dg-compile-aux-modules { args } {
     }
 }
 
+if { [getenv GFORTRAN_NUM_IMAGES] == "" } {
+  # Some caf_shmem tests need at least 8 images.  This is also to limit the
+  # number of images on big machines preventing overload w/o any benefit.
+  setenv GFORTRAN_NUM_IMAGES 8
+}
+
 # Main loop.
 foreach test [lsort [glob -nocomplain $srcdir/$subdir/*.\[fF\]{,90,95,03,08} ]] {
     # If we're only testing specific files and this isn't one of them, skip it.
@@ -103,6 +109,13 @@ foreach test [lsort [glob -nocomplain $srcdir/$subdir/*.\[fF\]{,90,95,03,08} ]]
 	dg-test $test "-fcoarray=lib $flags -lcaf_single" {}
 	cleanup-modules ""
     }
+
+    foreach flags $option_list {
+        verbose "Testing $nshort (libcaf_shmem), $flags" 1
+        set gfortran_aux_module_flags "-fcoarray=lib $flags -lcaf_shmem"
+        dg-test $test "-fcoarray=lib $flags -lcaf_shmem" {}
+        cleanup-modules ""
+    }
 }
 torture-finish
 dg-finish
diff --git a/gcc/testsuite/gfortran.dg/coarray/co_reduce_string.f90 b/gcc/testsuite/gfortran.dg/coarray/co_reduce_string.f90
new file mode 100644
index 0000000..9b4c44f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/co_reduce_string.f90
@@ -0,0 +1,94 @@
+!{ dg-do run }
+
+! Check that co_reduce for strings works.
+! This test is motivated by OpenCoarray's co_reduce_string test.
+
+program co_reduce_strings
+ 
+  implicit none
+
+  integer, parameter :: numstrings = 10, strlen = 8, base_len = 4
+  character(len=strlen), dimension(numstrings) :: fixarr
+  character(len=strlen), dimension(:), allocatable :: allocarr
+  character(len=:), allocatable :: defarr(:)
+  character(len=strlen) :: expect
+  integer :: i
+
+  ! Construct the strings by postfixing foo by a number.
+  associate (me => this_image(), np => num_images())
+    if (np > 999) error stop "Too many images; increase format string modifiers and sizes!"
+    
+    allocate(allocarr(numstrings))
+    do i = 1, numstrings
+      write(fixarr(i), "('foo',I04)") i * me
+      write(allocarr(i), "('foo',I04)") i * me
+    end do
+    ! Collectively reduce the maximum string.
+    call co_reduce(fixarr, fixmax)
+    call check(fixarr, 1)
+
+    call co_reduce(allocarr, strmax)
+    call check(allocarr, 2)
+  end associate
+
+  ! Construct the strings by postfixing foo by a number.
+  associate (me => this_image(), np => num_images())
+    allocate(character(len=base_len + 4)::defarr(numstrings))
+    do i = 1, numstrings
+      write(defarr(i), "('foo',I04)") i * me
+    end do
+    call sub_red(defarr)
+  end associate
+  sync all
+
+contains
+
+  pure function fixmax(lhs, rhs) result(m)
+    character(len=strlen), intent(in) :: lhs, rhs
+    character(len=strlen) :: m
+
+    if (lhs > rhs) then
+      m = lhs
+    else
+      m = rhs
+    end if
+  end function
+
+  pure function strmax(lhs, rhs) result(maxstr)
+    character(len=strlen), intent(in) :: lhs, rhs
+    character(len=strlen) :: maxstr
+
+    if (lhs > rhs) then
+      maxstr = lhs 
+    else 
+      maxstr = rhs
+    end if
+  end function
+
+  subroutine sub_red(str)
+    character(len=:), allocatable :: str(:)
+
+    call co_reduce(str, strmax)
+    call check(str, 3)
+  end subroutine
+
+  subroutine check(curr, stop_code)
+    character(len=*), intent(in) :: curr(:)
+    character(len=strlen) :: expect
+    integer, intent(in) :: stop_code
+    integer :: i
+
+    associate(np => num_images())
+      do i = 1, numstrings
+        write (expect, "('foo',I04)") i * np
+        if (curr(i) /= expect) then
+          ! On error print what we got and what we expected.
+          print *, this_image(), ": Got: ", curr(i), ", expected: ", expect, ", for i=", i
+          stop stop_code
+        end if
+      end do
+    end associate
+  end subroutine
+
+end program co_reduce_strings
+
diff --git a/gcc/testsuite/gfortran.dg/coarray/coarray_allocated.f90 b/gcc/testsuite/gfortran.dg/coarray/coarray_allocated.f90
index 27db0e8..ce7c628 100644
--- a/gcc/testsuite/gfortran.dg/coarray/coarray_allocated.f90
+++ b/gcc/testsuite/gfortran.dg/coarray/coarray_allocated.f90
@@ -19,7 +19,7 @@ program p
   ! For this reason, -fcoarray=single and -fcoarray=lib give the
   ! same result
   if (allocated (a[1])) stop 3
-  if (allocated (c%x[1,2,3])) stop 4
+  if (allocated (c%x[1,1,1])) stop 4
 
   ! Allocate collectively
   allocate(a[*])
@@ -28,16 +28,17 @@ program p
   if (.not. allocated (a)) stop 5
   if (.not. allocated (c%x)) stop 6
   if (.not. allocated (a[1])) stop 7
-  if (.not. allocated (c%x[1,2,3])) stop 8
+  if (.not. allocated (c%x[1,1,1])) stop 8
 
-  ! Deallocate collectively
+  sync all
+  ! Dellocate collectively
   deallocate(a)
   deallocate(c%x)
 
   if (allocated (a)) stop 9
   if (allocated (c%x)) stop 10
   if (allocated (a[1])) stop 11
-  if (allocated (c%x[1,2,3])) stop 12
+  if (allocated (c%x[1,1,1])) stop 12
 end
 
 ! Expected: always local access and never a call to _gfortran_caf_get
diff --git a/gcc/testsuite/gfortran.dg/coarray/coindexed_1.f90 b/gcc/testsuite/gfortran.dg/coarray/coindexed_1.f90
index f90b65c..8f7a83a 100644
--- a/gcc/testsuite/gfortran.dg/coarray/coindexed_1.f90
+++ b/gcc/testsuite/gfortran.dg/coarray/coindexed_1.f90
@@ -21,6 +21,7 @@ subroutine char_test()
   ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
   str1a = 1_"abc"
   str2a = 1_"XXXXXXX"
+  sync all
   if (this_image() == num_images()) then
     str2a[1] = str1a
   end if
@@ -37,6 +38,7 @@ subroutine char_test()
   ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
   ustr1a = 4_"abc"
   ustr2a = 4_"XXXXXXX"
+  sync all
   if (this_image() == num_images()) then
     ustr2a[1] = ustr1a
   end if
@@ -53,6 +55,7 @@ subroutine char_test()
   ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
   str2a = 1_"abcde"
   str1a = 1_"XXX"
+  sync all
   if (this_image() == num_images()) then
     str1a[1] = str2a
   end if
@@ -69,6 +72,7 @@ subroutine char_test()
   ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
   ustr2a = 4_"abcde"
   ustr1a = 4_"XXX"
+  sync all
   if (this_image() == num_images()) then
     ustr1a[1] = ustr2a
   end if
@@ -91,6 +95,7 @@ subroutine char_test()
   str2b(1) = 1_"XXXXXXX"
   str2b(2) = 1_"YYYYYYY"
   str2b(3) = 1_"ZZZZZZZ"
+  sync all
   if (this_image() == num_images()) then
     str2b(:)[1] = str1b
   end if
@@ -113,6 +118,7 @@ subroutine char_test()
   ustr2b(1) = 4_"XXXXXXX"
   ustr2b(2) = 4_"YYYYYYY"
   ustr2b(3) = 4_"ZZZZZZZ"
+  sync all
   if (this_image() == num_images()) then
     ustr2b(:)[1] = ustr1b
   end if
@@ -135,6 +141,7 @@ subroutine char_test()
   str1b(1) = 1_"XXX"
   str1b(2) = 1_"YYY"
   str1b(3) = 1_"ZZZ"
+  sync all
   if (this_image() == num_images()) then
     str1b(:)[1] = str2b
   end if
@@ -157,6 +164,7 @@ subroutine char_test()
   ustr1b(1) = 4_"XXX"
   ustr1b(2) = 4_"YYY"
   ustr1b(3) = 4_"ZZZ"
+  sync all
   if (this_image() == num_images()) then
     ustr1b(:)[1] = ustr2b
   end if
@@ -179,6 +187,7 @@ subroutine char_test()
   str2b(1) = 1_"XXXXXXX"
   str2b(2) = 1_"YYYYYYY"
   str2b(3) = 1_"ZZZZZZZ"
+  sync all
   if (this_image() == num_images()) then
     str2b(:)[1] = str1a
   end if
@@ -199,6 +208,7 @@ subroutine char_test()
   ustr2b(1) = 4_"XXXXXXX"
   ustr2b(2) = 4_"YYYYYYY"
   ustr2b(3) = 4_"ZZZZZZZ"
+  sync all
   if (this_image() == num_images()) then
     ustr2b(:)[1] = ustr1a
   end if
@@ -219,6 +229,7 @@ subroutine char_test()
   str1b(1) = 1_"XXX"
   str1b(2) = 1_"YYY"
   str1b(3) = 1_"ZZZ"
+  sync all
   if (this_image() == num_images()) then
     str1b(:)[1] = str2a
   end if
@@ -239,6 +250,7 @@ subroutine char_test()
   ustr1b(1) = 4_"XXX"
   ustr1b(2) = 4_"YYY"
   ustr1b(3) = 4_"ZZZ"
+  sync all
   if (this_image() == num_images()) then
     ustr1b(:)[1] = ustr2a
   end if
@@ -261,6 +273,7 @@ subroutine char_test()
   ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
   str1a = 1_"abc"
   str2a = 1_"XXXXXXX"
+  sync all
   if (this_image() == num_images()) then
     str2a = str1a[1]
   end if
@@ -277,6 +290,7 @@ subroutine char_test()
   ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
   ustr1a = 4_"abc"
   ustr2a = 4_"XXXXXXX"
+  sync all
   if (this_image() == num_images()) then
     ustr2a = ustr1a[1]
   end if
@@ -293,6 +307,7 @@ subroutine char_test()
   ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
   str2a = 1_"abcde"
   str1a = 1_"XXX"
+  sync all
   if (this_image() == num_images()) then
     str1a = str2a[1]
   end if
@@ -309,6 +324,7 @@ subroutine char_test()
   ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
   ustr2a = 4_"abcde"
   ustr1a = 4_"XXX"
+  sync all
   if (this_image() == num_images()) then
     ustr1a = ustr2a[1]
   end if
@@ -331,6 +347,7 @@ subroutine char_test()
   str2b(1) = 1_"XXXXXXX"
   str2b(2) = 1_"YYYYYYY"
   str2b(3) = 1_"ZZZZZZZ"
+  sync all
   if (this_image() == num_images()) then
     str2b = str1b(:)[1]
   end if
@@ -353,6 +370,7 @@ subroutine char_test()
   ustr2b(1) = 4_"XXXXXXX"
   ustr2b(2) = 4_"YYYYYYY"
   ustr2b(3) = 4_"ZZZZZZZ"
+  sync all
   if (this_image() == num_images()) then
     ustr2b = ustr1b(:)[1]
   end if
@@ -375,6 +393,7 @@ subroutine char_test()
   str1b(1) = 1_"XXX"
   str1b(2) = 1_"YYY"
   str1b(3) = 1_"ZZZ"
+  sync all
   if (this_image() == num_images()) then
     str1b = str2b(:)[1]
   end if
@@ -397,6 +416,7 @@ subroutine char_test()
   ustr1b(1) = 4_"XXX"
   ustr1b(2) = 4_"YYY"
   ustr1b(3) = 4_"ZZZ"
+  sync all
   if (this_image() == num_images()) then
     ustr1b = ustr2b(:)[1]
   end if
@@ -419,6 +439,7 @@ subroutine char_test()
   str2b(1) = 1_"XXXXXXX"
   str2b(2) = 1_"YYYYYYY"
   str2b(3) = 1_"ZZZZZZZ"
+  sync all
   if (this_image() == num_images()) then
     str2b = str1a[1]
   end if
@@ -439,6 +460,7 @@ subroutine char_test()
   ustr2b(1) = 4_"XXXXXXX"
   ustr2b(2) = 4_"YYYYYYY"
   ustr2b(3) = 4_"ZZZZZZZ"
+  sync all
   if (this_image() == num_images()) then
     ustr2b = ustr1a[1]
   end if
@@ -459,6 +481,7 @@ subroutine char_test()
   str1b(1) = 1_"XXX"
   str1b(2) = 1_"YYY"
   str1b(3) = 1_"ZZZ"
+  sync all
   if (this_image() == num_images()) then
     str1b = str2a[1]
   end if
@@ -479,6 +502,7 @@ subroutine char_test()
   ustr1b(1) = 4_"XXX"
   ustr1b(2) = 4_"YYY"
   ustr1b(3) = 4_"ZZZ"
+  sync all
   if (this_image() == num_images()) then
     ustr1b = ustr2a[1]
   end if
@@ -502,6 +526,7 @@ subroutine char_test()
   ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
   str1a = 1_"abc"
   str2a = 1_"XXXXXXX"
+  sync all
   if (this_image() == num_images()) then
     str2a[1] = str1a[mod(1, num_images())+1]
   end if
@@ -518,6 +543,7 @@ subroutine char_test()
   ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
   ustr1a = 4_"abc"
   ustr2a = 4_"XXXXXXX"
+  sync all
   if (this_image() == num_images()) then
     ustr2a[1] = ustr1a[mod(1, num_images())+1]
   end if
@@ -534,6 +560,7 @@ subroutine char_test()
   ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
   str2a = 1_"abcde"
   str1a = 1_"XXX"
+  sync all
   if (this_image() == num_images()) then
     str1a[1] = str2a[mod(1, num_images())+1]
   end if
@@ -550,6 +577,7 @@ subroutine char_test()
   ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
   ustr2a = 4_"abcde"
   ustr1a = 4_"XXX"
+  sync all
   if (this_image() == num_images()) then
     ustr1a[1] = ustr2a[mod(1, num_images())+1]
   end if
@@ -572,6 +600,7 @@ subroutine char_test()
   str2b(1) = 1_"XXXXXXX"
   str2b(2) = 1_"YYYYYYY"
   str2b(3) = 1_"ZZZZZZZ"
+  sync all
   if (this_image() == num_images()) then
     str2b(:)[1] = str1b(:)[mod(1, num_images())+1]
   end if
@@ -594,6 +623,7 @@ subroutine char_test()
   ustr2b(1) = 4_"XXXXXXX"
   ustr2b(2) = 4_"YYYYYYY"
   ustr2b(3) = 4_"ZZZZZZZ"
+  sync all
   if (this_image() == num_images()) then
     ustr2b(:)[1] = ustr1b(:)[mod(1, num_images())+1]
   end if
@@ -616,6 +646,7 @@ subroutine char_test()
   str1b(1) = 1_"XXX"
   str1b(2) = 1_"YYY"
   str1b(3) = 1_"ZZZ"
+  sync all
   if (this_image() == num_images()) then
     str1b(:)[1] = str2b(:)[mod(1, num_images())+1]
   end if
@@ -638,6 +669,7 @@ subroutine char_test()
   ustr1b(1) = 4_"XXX"
   ustr1b(2) = 4_"YYY"
   ustr1b(3) = 4_"ZZZ"
+  sync all
   if (this_image() == num_images()) then
     ustr1b(:)[1] = ustr2b(:)[mod(1, num_images())+1]
   end if
@@ -660,6 +692,7 @@ subroutine char_test()
   str2b(1) = 1_"XXXXXXX"
   str2b(2) = 1_"YYYYYYY"
   str2b(3) = 1_"ZZZZZZZ"
+  sync all
   if (this_image() == num_images()) then
     str2b(:)[1] = str1a[mod(1, num_images())+1]
   end if
@@ -680,6 +713,7 @@ subroutine char_test()
   ustr2b(1) = 4_"XXXXXXX"
   ustr2b(2) = 4_"YYYYYYY"
   ustr2b(3) = 4_"ZZZZZZZ"
+  sync all
   if (this_image() == num_images()) then
     ustr2b(:)[1] = ustr1a[mod(1, num_images())+1]
   end if
@@ -700,6 +734,7 @@ subroutine char_test()
   str1b(1) = 1_"XXX"
   str1b(2) = 1_"YYY"
   str1b(3) = 1_"ZZZ"
+  sync all
   if (this_image() == num_images()) then
     str1b(:)[1] = str2a[mod(1, num_images())+1]
   end if
@@ -720,6 +755,7 @@ subroutine char_test()
   ustr1b(1) = 4_"XXX"
   ustr1b(2) = 4_"YYY"
   ustr1b(3) = 4_"ZZZ"
+  sync all
   if (this_image() == num_images()) then
     ustr1b(:)[1] = ustr2a[mod(1, num_images())+1]
   end if
@@ -743,7 +779,8 @@ subroutine char_test()
   str2a = 1_"zzzzzzzz"; str2b = 1_"zzzzzzzz"
   ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
   ustr1a = 4_"abc"
-  str1a = 1_"XXXXXXX"
+  str2a = 1_"XXXXXXX"
+  sync all
   if (this_image() == num_images()) then
     str2a[1] = ustr1a
   end if
@@ -760,6 +797,7 @@ subroutine char_test()
   ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
   str1a = 4_"abc"
   ustr2a = 1_"XXXXXXX"
+  sync all
   if (this_image() == num_images()) then
     ustr2a[1] = str1a
   end if
@@ -776,6 +814,7 @@ subroutine char_test()
   ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
   ustr2a = 4_"abcde"
   str1a = 1_"XXX"
+  sync all
   if (this_image() == num_images()) then
     str1a[1] = ustr2a
   end if
@@ -792,6 +831,7 @@ subroutine char_test()
   ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
   str2a = 4_"abcde"
   ustr1a = 1_"XXX"
+  sync all
   if (this_image() == num_images()) then
     ustr1a[1] = str2a
   end if
@@ -814,6 +854,7 @@ subroutine char_test()
   str2b(1) = 1_"XXXXXXX"
   str2b(2) = 1_"YYYYYYY"
   str2b(3) = 1_"ZZZZZZZ"
+  sync all
   if (this_image() == num_images()) then
     str2b(:)[1] = ustr1b
   end if
@@ -836,6 +877,7 @@ subroutine char_test()
   ustr2b(1) = 4_"XXXXXXX"
   ustr2b(2) = 4_"YYYYYYY"
   ustr2b(3) = 4_"ZZZZZZZ"
+  sync all
   if (this_image() == num_images()) then
     ustr2b(:)[1] = str1b
   end if
@@ -858,6 +900,7 @@ subroutine char_test()
   str1b(1) = 1_"XXX"
   str1b(2) = 1_"YYY"
   str1b(3) = 1_"ZZZ"
+  sync all
   if (this_image() == num_images()) then
     str1b(:)[1] = ustr2b
   end if
@@ -880,6 +923,7 @@ subroutine char_test()
   ustr1b(1) = 4_"XXX"
   ustr1b(2) = 4_"YYY"
   ustr1b(3) = 4_"ZZZ"
+  sync all
   if (this_image() == num_images()) then
     ustr1b(:)[1] = str2b
   end if
@@ -902,6 +946,7 @@ subroutine char_test()
   str2b(1) = 1_"XXXXXXX"
   str2b(2) = 1_"YYYYYYY"
   str2b(3) = 1_"ZZZZZZZ"
+  sync all
   if (this_image() == num_images()) then
     str2b(:)[1] = ustr1a
   end if
@@ -922,6 +967,7 @@ subroutine char_test()
   ustr2b(1) = 4_"XXXXXXX"
   ustr2b(2) = 4_"YYYYYYY"
   ustr2b(3) = 4_"ZZZZZZZ"
+  sync all
   if (this_image() == num_images()) then
     ustr2b(:)[1] = str1a
   end if
@@ -942,6 +988,7 @@ subroutine char_test()
   str1b(1) = 1_"XXX"
   str1b(2) = 1_"YYY"
   str1b(3) = 1_"ZZZ"
+  sync all
   if (this_image() == num_images()) then
     str1b(:)[1] = ustr2a
   end if
@@ -962,6 +1009,7 @@ subroutine char_test()
   ustr1b(1) = 4_"XXX"
   ustr1b(2) = 4_"YYY"
   ustr1b(3) = 4_"ZZZ"
+  sync all
   if (this_image() == num_images()) then
     ustr1b(:)[1] = str2a
   end if
@@ -984,6 +1032,7 @@ subroutine char_test()
   ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
   ustr1a = 4_"abc"
   str2a = 1_"XXXXXXX"
+  sync all
   if (this_image() == num_images()) then
     str2a = ustr1a[1]
   end if
@@ -1000,6 +1049,7 @@ subroutine char_test()
   ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
   str1a = 1_"abc"
   ustr2a = 4_"XXXXXXX"
+  sync all
   if (this_image() == num_images()) then
     ustr2a = str1a[1]
   end if
@@ -1016,6 +1066,7 @@ subroutine char_test()
   ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
   ustr2a = 4_"abcde"
   str1a = 1_"XXX"
+  sync all
   if (this_image() == num_images()) then
     str1a = ustr2a[1]
   end if
@@ -1032,6 +1083,7 @@ subroutine char_test()
   ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
   str2a = 1_"abcde"
   ustr1a = 4_"XXX"
+  sync all
   if (this_image() == num_images()) then
     ustr1a = str2a[1]
   end if
@@ -1054,6 +1106,7 @@ subroutine char_test()
   str2b(1) = 1_"XXXXXXX"
   str2b(2) = 1_"YYYYYYY"
   str2b(3) = 1_"ZZZZZZZ"
+  sync all
   if (this_image() == num_images()) then
     str2b = ustr1b(:)[1]
   end if
@@ -1076,6 +1129,7 @@ subroutine char_test()
   ustr2b(1) = 4_"XXXXXXX"
   ustr2b(2) = 4_"YYYYYYY"
   ustr2b(3) = 4_"ZZZZZZZ"
+  sync all
   if (this_image() == num_images()) then
     ustr2b = str1b(:)[1]
   end if
@@ -1098,6 +1152,7 @@ subroutine char_test()
   str1b(1) = 1_"XXX"
   str1b(2) = 1_"YYY"
   str1b(3) = 1_"ZZZ"
+  sync all
   if (this_image() == num_images()) then
     str1b = ustr2b(:)[1]
   end if
@@ -1120,6 +1175,7 @@ subroutine char_test()
   ustr1b(1) = 4_"XXX"
   ustr1b(2) = 4_"YYY"
   ustr1b(3) = 4_"ZZZ"
+  sync all
   if (this_image() == num_images()) then
     ustr1b = str2b(:)[1]
   end if
@@ -1142,6 +1198,7 @@ subroutine char_test()
   str2b(1) = 1_"XXXXXXX"
   str2b(2) = 1_"YYYYYYY"
   str2b(3) = 1_"ZZZZZZZ"
+  sync all
   if (this_image() == num_images()) then
     str2b = ustr1a[1]
   end if
@@ -1162,6 +1219,7 @@ subroutine char_test()
   ustr2b(1) = 4_"XXXXXXX"
   ustr2b(2) = 4_"YYYYYYY"
   ustr2b(3) = 4_"ZZZZZZZ"
+  sync all
   if (this_image() == num_images()) then
     ustr2b = str1a[1]
   end if
@@ -1182,6 +1240,7 @@ subroutine char_test()
   str1b(1) = 1_"XXX"
   str1b(2) = 1_"YYY"
   str1b(3) = 1_"ZZZ"
+  sync all
   if (this_image() == num_images()) then
     str1b = ustr2a[1]
   end if
@@ -1202,6 +1261,7 @@ subroutine char_test()
   ustr1b(1) = 4_"XXX"
   ustr1b(2) = 4_"YYY"
   ustr1b(3) = 4_"ZZZ"
+  sync all
   if (this_image() == num_images()) then
     ustr1b = str2a[1]
   end if
@@ -1225,6 +1285,7 @@ subroutine char_test()
   ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
   ustr1a = 4_"abc"
   str2a = 1_"XXXXXXX"
+  sync all
   if (this_image() == num_images()) then
     str2a[1] = ustr1a[mod(1, num_images())+1]
   end if
@@ -1241,6 +1302,7 @@ subroutine char_test()
   ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
   str1a = 1_"abc"
   ustr2a = 4_"XXXXXXX"
+  sync all
   if (this_image() == num_images()) then
     ustr2a[1] = str1a[mod(1, num_images())+1]
   end if
@@ -1257,6 +1319,7 @@ subroutine char_test()
   ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
   ustr2a = 4_"abcde"
   str1a = 1_"XXX"
+  sync all
   if (this_image() == num_images()) then
     str1a[1] = ustr2a[mod(1, num_images())+1]
   end if
@@ -1273,6 +1336,7 @@ subroutine char_test()
   ustr2a = 4_"zzzzzzzz"; ustr2b = 4_"zzzzzzzz"
   str2a = 1_"abcde"
   ustr1a = 4_"XXX"
+  sync all
   if (this_image() == num_images()) then
     ustr1a[1] = str2a[mod(1, num_images())+1]
   end if
@@ -1295,6 +1359,7 @@ subroutine char_test()
   str2b(1) = 1_"XXXXXXX"
   str2b(2) = 1_"YYYYYYY"
   str2b(3) = 1_"ZZZZZZZ"
+  sync all
   if (this_image() == num_images()) then
     str2b(:)[1] = ustr1b(:)[mod(1, num_images())+1]
   end if
@@ -1317,6 +1382,7 @@ subroutine char_test()
   ustr2b(1) = 4_"XXXXXXX"
   ustr2b(2) = 4_"YYYYYYY"
   ustr2b(3) = 4_"ZZZZZZZ"
+  sync all
   if (this_image() == num_images()) then
     ustr2b(:)[1] = str1b(:)[mod(1, num_images())+1]
   end if
@@ -1339,6 +1405,7 @@ subroutine char_test()
   str1b(1) = 1_"XXX"
   str1b(2) = 1_"YYY"
   str1b(3) = 1_"ZZZ"
+  sync all
   if (this_image() == num_images()) then
     str1b(:)[1] = ustr2b(:)[mod(1, num_images())+1]
   end if
@@ -1361,6 +1428,7 @@ subroutine char_test()
   ustr1b(1) = 4_"XXX"
   ustr1b(2) = 4_"YYY"
   ustr1b(3) = 4_"ZZZ"
+  sync all
   if (this_image() == num_images()) then
     ustr1b(:)[1] = str2b(:)[mod(1, num_images())+1]
   end if
@@ -1383,6 +1451,7 @@ subroutine char_test()
   str2b(1) = 1_"XXXXXXX"
   str2b(2) = 1_"YYYYYYY"
   str2b(3) = 1_"ZZZZZZZ"
+  sync all
   if (this_image() == num_images()) then
     str2b(:)[1] = ustr1a[mod(1, num_images())+1]
   end if
@@ -1403,6 +1472,7 @@ subroutine char_test()
   ustr2b(1) = 4_"XXXXXXX"
   ustr2b(2) = 4_"YYYYYYY"
   ustr2b(3) = 4_"ZZZZZZZ"
+  sync all
   if (this_image() == num_images()) then
     ustr2b(:)[1] = str1a[mod(1, num_images())+1]
   end if
@@ -1423,6 +1493,7 @@ subroutine char_test()
   str1b(1) = 1_"XXX"
   str1b(2) = 1_"YYY"
   str1b(3) = 1_"ZZZ"
+  sync all
   if (this_image() == num_images()) then
     str1b(:)[1] = ustr2a[mod(1, num_images())+1]
   end if
@@ -1443,6 +1514,7 @@ subroutine char_test()
   ustr1b(1) = 4_"XXX"
   ustr1b(2) = 4_"YYY"
   ustr1b(3) = 4_"ZZZ"
+  sync all
   if (this_image() == num_images()) then
     ustr1b(:)[1] = str2a[mod(1, num_images())+1]
   end if
diff --git a/gcc/testsuite/gfortran.dg/coarray/coindexed_3.f08 b/gcc/testsuite/gfortran.dg/coarray/coindexed_3.f08
index 7fd2085..145835d 100644
--- a/gcc/testsuite/gfortran.dg/coarray/coindexed_3.f08
+++ b/gcc/testsuite/gfortran.dg/coarray/coindexed_3.f08
@@ -15,8 +15,8 @@ program pr98903
   a = 42
   s = 42
 
-  ! Checking against single image only.  Therefore team statements are
-  ! not viable nor are they (yet) supported by GFortran.
+  sync all
+  
   if (a[1, team_number=-1, stat=s] /= 42) stop 1
   if (s /= 0) stop 2
 
diff --git a/gcc/testsuite/gfortran.dg/coarray/coindexed_5.f90 b/gcc/testsuite/gfortran.dg/coarray/coindexed_5.f90
index c35ec10..8eb6466 100644
--- a/gcc/testsuite/gfortran.dg/coarray/coindexed_5.f90
+++ b/gcc/testsuite/gfortran.dg/coarray/coindexed_5.f90
@@ -13,68 +13,72 @@ program coindexed_5
   parentteam = get_team()
 
   caf = [23, 32]
-  form team(t_num, team, new_index=1)
+  form team(t_num, team) !, new_index=num_images() - this_image() + 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
+    associate(me => this_image())
+      ! for get_from_remote
+      ! Checking against caf_single is very limitted.
+      if (cell[me, team_number=t_num] /= 32) stop 1
+      if (cell[me, team_number=st_num] /= 32) stop 2
+      if (cell[me, 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 team_number is validated
+      lhs = cell[me, 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
+      ! Check that only access to active teams is valid
+      stat = 42
+      lhs = cell[me, 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
+      ! for send_to_remote
+      ! Checking against caf_single is very limitted.
+      cell[me, team_number=t_num] = 45
+      if (cell /= 45) stop 11
+      cell[me, team_number=st_num] = 46
+      if (cell /= 46) stop 12
+      cell[me, 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 team_number is validated
+      stat = -1
+      cell[me, 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
+      ! Check that only access to active teams is valid
+      stat = 42
+      cell[me, 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
+      ! for transfer_between_remotes
+      ! Checking against caf_single is very limitted.
+      cell[me, team_number=t_num] = caf(1)[me, team_number=-1]
+      if (cell /= 23) stop 21
+      cell[me, team_number=st_num] = caf(2)[me, team_number=-1]
+      ! cell is an alias for caf(2) and has been overwritten by caf(1)!
+      if (cell /= 23) stop 22
+      cell[me, team=parentteam] = caf(1)[me, 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 team_number is validated
+      stat = -1
+      cell[me, team_number=5, stat=stat] = caf(1)[me, team_number= -1]
+      if (stat /= 1) stop 24
+      stat = -1
+      cell[me, team_number=t_num] = caf(1)[me, 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
+      ! Check that only access to active teams is valid
+      stat = 42
+      cell[me, team=formed_team, stat=stat] = caf(1)[me]
+      if (stat /= 1) stop 26
+      stat = 42
+      cell[me] = caf(1)[me, team=formed_team, stat=stat]
+      if (stat /= 1) stop 27
+
+      sync all
+    end associate
   end team
 end program coindexed_5
diff --git a/gcc/testsuite/gfortran.dg/coarray/dummy_3.f90 b/gcc/testsuite/gfortran.dg/coarray/dummy_3.f90
index 4b45daa..c569390 100644
--- a/gcc/testsuite/gfortran.dg/coarray/dummy_3.f90
+++ b/gcc/testsuite/gfortran.dg/coarray/dummy_3.f90
@@ -15,6 +15,7 @@ program pr77871
    p%i = 42
    allocate (p2(5)[*])
    p2(:)%i = (/(i, i=0, 4)/)
+   sync all
    call s(p, 1)
    call s2(p2, 1)
 contains
diff --git a/gcc/testsuite/gfortran.dg/coarray/event_1.f90 b/gcc/testsuite/gfortran.dg/coarray/event_1.f90
index 81dc90b..a9fecf9 100644
--- a/gcc/testsuite/gfortran.dg/coarray/event_1.f90
+++ b/gcc/testsuite/gfortran.dg/coarray/event_1.f90
@@ -5,47 +5,54 @@
 use iso_fortran_env, only: event_type
 implicit none
 
-type(event_type), save :: var[*]
+type(event_type), save, allocatable, dimension(:) :: events[:]
 integer :: count, stat
 
-count = -42
-call event_query (var, count)
-if (count /= 0) STOP 1
-
-stat = 99
-event post (var, stat=stat)
-if (stat /= 0) STOP 2
-call event_query(var, count, stat=stat)
-if (count /= 1 .or. stat /= 0) STOP 3
-
-stat = 99
-event post (var[this_image()])
-call event_query(var, count)
-if (count /= 2) STOP 4
-
-stat = 99
-event wait (var)
-call event_query(var, count)
-if (count /= 1) STOP 5
-
-stat = 99
-event post (var)
-call event_query(var, count)
-if (count /= 2) STOP 6
-
-stat = 99
-event post (var)
-call event_query(var, count)
-if (count /= 3) STOP 7
-
-stat = 99
-event wait (var, until_count=2)
-call event_query(var, count)
-if (count /= 1) STOP 8
-
-stat = 99
-event wait (var, stat=stat, until_count=1)
-if (stat /= 0) STOP 9
-call event_query(event=var, stat=stat, count=count)
-if (count /= 0 .or. stat /= 0) STOP 10
+associate (me => this_image(), np => num_images())
+  allocate(events(np)[*])
+
+  associate(var => events(me))
+    count = -42
+    call event_query (var, count)
+    if (count /= 0) STOP 1
+
+    stat = 99
+    event post (var, stat=stat)
+    if (stat /= 0) STOP 2
+    call event_query(var, count, stat=stat)
+    if (count /= 1 .or. stat /= 0) STOP 3
+
+    count = 99
+    event post (var[this_image()])
+    call event_query(var, count)
+    if (count /= 2) STOP 4
+
+    count = 99
+    event wait (var)
+    call event_query(var, count)
+    if (count /= 1) STOP 5
+
+    count = 99
+    event post (var)
+    call event_query(var, count)
+    if (count /= 2) STOP 6
+
+    count = 99
+    event post (var)
+    call event_query(var, count)
+    if (count /= 3) STOP 7
+
+    count = 99
+    event wait (var, until_count=2)
+    call event_query(var, count)
+    if (count /= 1) STOP 8
+   
+    stat = 99
+    event wait (var, stat=stat, until_count=1)
+    if (stat /= 0) STOP 9
+    count = 99
+    call event_query(event=var, stat=stat, count=count)
+    if (count /= 0 .or. stat /= 0) STOP 10
+  end associate
+end associate
 end
diff --git a/gcc/testsuite/gfortran.dg/coarray/event_3.f08 b/gcc/testsuite/gfortran.dg/coarray/event_3.f08
index 60d3193..cedf636 100644
--- a/gcc/testsuite/gfortran.dg/coarray/event_3.f08
+++ b/gcc/testsuite/gfortran.dg/coarray/event_3.f08
@@ -11,8 +11,8 @@ program global_event
   contains
     subroutine exchange
       integer :: cnt
-      event post(x[1])
-      event post(x[1])
+      event post(x[this_image()])
+      event post(x[this_image()])
       call event_query(x, cnt)
       if (cnt /= 2) error stop 1
       event wait(x, until_count=2)
diff --git a/gcc/testsuite/gfortran.dg/coarray/event_4.f08 b/gcc/testsuite/gfortran.dg/coarray/event_4.f08
index de901c0..26a1f59 100644
--- a/gcc/testsuite/gfortran.dg/coarray/event_4.f08
+++ b/gcc/testsuite/gfortran.dg/coarray/event_4.f08
@@ -8,5 +8,6 @@ program event_4
   type(event_type) done[*]
   nc(1) = 1
   event post(done[1])
-  event wait(done,until_count=nc(1))
+  if (this_image() == 1) event wait(done,until_count=nc(1))
+  sync all
 end
diff --git a/gcc/testsuite/gfortran.dg/coarray/failed_images_1.f08 b/gcc/testsuite/gfortran.dg/coarray/failed_images_1.f08
index 4898dd8..34ae131 100644
--- a/gcc/testsuite/gfortran.dg/coarray/failed_images_1.f08
+++ b/gcc/testsuite/gfortran.dg/coarray/failed_images_1.f08
@@ -8,7 +8,7 @@ program test_failed_images_1
   integer :: i
 
   fi = failed_images()         ! OK
-  fi = failed_images(TEAM=1)   ! { dg-error "'team' argument of 'failed_images' intrinsic at \\(1\\) not yet supported" }
+  fi = failed_images(TEAM=1)   ! { dg-error "'team' argument of 'failed_images' intrinsic at \\(1\\) shall be of type 'team_type' from the intrinsic module 'ISO_FORTRAN_ENV'" }
   fi = failed_images(KIND=1)   ! OK
   fi = failed_images(KIND=4)   ! OK
   fi = failed_images(KIND=0)   ! { dg-error "'kind' argument of 'failed_images' intrinsic at \\\(1\\\) must be positive" }
diff --git a/gcc/testsuite/gfortran.dg/coarray/failed_images_2.f08 b/gcc/testsuite/gfortran.dg/coarray/failed_images_2.f08
index ca5fe40..78d92da 100644
--- a/gcc/testsuite/gfortran.dg/coarray/failed_images_2.f08
+++ b/gcc/testsuite/gfortran.dg/coarray/failed_images_2.f08
@@ -1,17 +1,44 @@
 ! { dg-do run }
 
 program test_failed_images_2
+  use iso_fortran_env
   implicit none
 
+  type(team_type) :: t
   integer, allocatable :: fi(:)
   integer(kind=1), allocatable :: sfi(:)
+  integer, allocatable :: rem_images(:)
+  integer :: i, st
 
-  fi = failed_images()
-  if (size(fi) > 0) error stop "failed_images result shall be empty array"
-  sfi = failed_images(KIND=1)
-  if (size(sfi) > 0) error stop "failed_images result shall be empty array"
-  sfi = failed_images(KIND=8)
-  if (size(sfi) > 0) error stop "failed_images result shall be empty array"
+  associate(np => num_images())
+    form team (1, t)
+    fi = failed_images()
+    if (size(fi) > 0) stop 1
+    sfi = failed_images(KIND=1)
+    if (size(sfi) > 0) stop 2
+    sfi = failed_images(KIND=8)
+    if (size(sfi) > 0) stop 3
+    
+    fi = failed_images(t)
+    if (size(fi) > 0) stop 4
   
+    if (num_images() > 1) then
+      sync all
+      if (this_image() == 2) fail image
+      rem_images = (/ 1, ( i, i = 3, np )/)
+      ! Can't synchronize well on a failed image.  Try with a sleep.
+      do i = 0, 10
+        if (size(failed_images()) == 0) then
+          call sleep(1)
+        else
+          exit
+        end if
+      end do
+      if (i == 10 .AND. size(failed_images()) == 0) stop 5
+      sync images (rem_images, stat=st)
+      if (any(failed_images() /= [2])) stop 6
+      if (any(failed_images(t, 8) /= [2])) stop 7
+    end if
+  end associate
 end program test_failed_images_2
 
diff --git a/gcc/testsuite/gfortran.dg/coarray/image_status_1.f08 b/gcc/testsuite/gfortran.dg/coarray/image_status_1.f08
index b7ec5a6..f725f81 100644
--- a/gcc/testsuite/gfortran.dg/coarray/image_status_1.f08
+++ b/gcc/testsuite/gfortran.dg/coarray/image_status_1.f08
@@ -18,7 +18,7 @@ program test_image_status_1
   isv = image_status(k2) ! Ok
   isv = image_status(k4) ! Ok
   isv = image_status(k8) ! Ok
-  isv = image_status(1, team=1) ! { dg-error "shall be of type 'team_type'" }
+  isv = image_status(1, team=1) ! { dg-error "'team' argument of 'image_status' intrinsic at \\(1\\) shall be of type 'team_type'" }
   isv = image_status()          ! { dg-error "Missing actual argument 'image' in call to 'image_status' at \\(1\\)" }
   isv = image_status(team=1)    ! { dg-error "Missing actual argument 'image' in call to 'image_status' at \\(1\\)" }
 
diff --git a/gcc/testsuite/gfortran.dg/coarray/image_status_2.f08 b/gcc/testsuite/gfortran.dg/coarray/image_status_2.f08
index fb49289..8866f23 100644
--- a/gcc/testsuite/gfortran.dg/coarray/image_status_2.f08
+++ b/gcc/testsuite/gfortran.dg/coarray/image_status_2.f08
@@ -1,12 +1,38 @@
 ! { dg-do run }
 
 program test_image_status_2
-  use iso_fortran_env , only : STAT_STOPPED_IMAGE
+  use iso_fortran_env
   implicit none
 
+  type(team_type) :: t
+  integer :: i, st
+  integer, allocatable :: rem_images(:)
+
+  form team (1, t)
+
   if (image_status(1) /= 0) error stop "Image 1 should report OK."
-  if (image_status(2) /= STAT_STOPPED_IMAGE) error stop "Image 2 should be stopped."
-  if (image_status(3) /= STAT_STOPPED_IMAGE) error stop "Image 3 should be stopped."
+  if (image_status(num_images() + 1) /= STAT_STOPPED_IMAGE) error stop "Image should be stopped."
+
+  if (image_status(1, t) /= 0) error stop "Image 1 in team t should report OK."
+
+  if (num_images() > 1) then
+    associate (np => num_images())
+      sync all
+      if (this_image() == 2) fail image 
+      rem_images = (/ 1, ( i, i = 3, np )/)
+      ! Can't synchronize well on failed image.  Try with a sleep.
+      do i = 0, 10
+        if (image_status(2) /= STAT_FAILED_IMAGE) then
+          call sleep(1)
+        else
+          exit
+        end if
+      end do
+      sync images (rem_images, stat=st)
+      if (image_status(2) /= STAT_FAILED_IMAGE) error stop "Image 2 has NOT status failed."
+      if (image_status(2, t) /= STAT_FAILED_IMAGE) error stop "Image 2 has NOT status failed."
+    end associate
+  end if
 
 end program test_image_status_2
 
diff --git a/gcc/testsuite/gfortran.dg/coarray/lock_2.f90 b/gcc/testsuite/gfortran.dg/coarray/lock_2.f90
index 8e96154..3d445b9 100644
--- a/gcc/testsuite/gfortran.dg/coarray/lock_2.f90
+++ b/gcc/testsuite/gfortran.dg/coarray/lock_2.f90
@@ -58,6 +58,8 @@ if (stat /= 0) STOP 9
 UNLOCK(lock3(4), stat=stat)
 if (stat /= 0) STOP 10
 
+! Ensure all other (/=1) images have released the locks.
+sync all
 if (this_image() == 1) then
   acquired = .false.
   LOCK (lock1[this_image()], acquired_lock=acquired)
diff --git a/gcc/testsuite/gfortran.dg/coarray/poly_run_3.f90 b/gcc/testsuite/gfortran.dg/coarray/poly_run_3.f90
index c284a56..4da1b95 100644
--- a/gcc/testsuite/gfortran.dg/coarray/poly_run_3.f90
+++ b/gcc/testsuite/gfortran.dg/coarray/poly_run_3.f90
@@ -12,28 +12,28 @@ allocate(a(1)[*])
 if (this_image() == 1 .and. any (this_image(a) /= lcobound(a))) &
   STOP 1
 if (any (lcobound(a) /= 1)) STOP 2
-if (any (ucobound(a) /= this_image())) STOP 3
+if (any (ucobound(a) /= num_images())) STOP 3
 deallocate(a)
 
 allocate(b[*])
 if (this_image() == 1 .and. any (this_image(b) /= lcobound(b))) &
   STOP 4
 if (any (lcobound(b) /= 1)) STOP 5
-if (any (ucobound(b) /= this_image())) STOP 6
+if (any (ucobound(b) /= num_images())) STOP 6
 deallocate(b)
 
 allocate(a(1)[-10:*])
 if (this_image() == 1 .and. any (this_image(a) /= lcobound(a))) &
   STOP 7
 if (any (lcobound(a) /= -10)) STOP 8
-if (any (ucobound(a) /= -11+this_image())) STOP 9
+if (any (ucobound(a) /= -11 + num_images())) STOP 9
 deallocate(a)
 
 allocate(d[23:*])
 if (this_image() == 1 .and. any (this_image(d) /= lcobound(d))) &
   STOP 10
 if (any (lcobound(d) /= 23)) STOP 11
-if (any (ucobound(d) /= 22+this_image())) STOP 12
+if (any (ucobound(d) /= 22 + num_images())) STOP 12
 deallocate(d)
 
 end
diff --git a/gcc/testsuite/gfortran.dg/coarray/scalar_alloc_1.f90 b/gcc/testsuite/gfortran.dg/coarray/scalar_alloc_1.f90
index b0d27bd..8dd7df5 100644
--- a/gcc/testsuite/gfortran.dg/coarray/scalar_alloc_1.f90
+++ b/gcc/testsuite/gfortran.dg/coarray/scalar_alloc_1.f90
@@ -19,7 +19,7 @@ if (lcobound(a, dim=1) /= 1 .or. ucobound(a,dim=1) /= num_images()) &
 deallocate(a)
 
 allocate(a[4:*])
-a[this_image ()] = 8 - 2*this_image ()
+a[this_image () + 3] = 8 - 2*this_image ()
 
 if (lcobound(a, dim=1) /= 4 .or. ucobound(a,dim=1) /= 3 + num_images()) &
   STOP 4
@@ -30,6 +30,7 @@ n3 = 3
 allocate (B[n1:n2, n3:*])
 if (any (lcobound(b) /= [-1, 3]) .or. lcobound(B, dim=2) /= n3) &
   STOP 5
+sync all
 call sub(A, B)
 
 if (allocated (a)) STOP 6
@@ -47,7 +48,8 @@ contains
       STOP 8
     if (lcobound(x, dim=1) /= 4 .or. ucobound(x,dim=1) /= 3 + num_images()) &
       STOP 9
-    if (x[this_image ()] /= 8 - 2*this_image ()) STOP 3
+    if (x[this_image () + 3] /= 8 - 2*this_image ()) STOP 10
+    sync all
     deallocate(x)
   end subroutine sub
 
@@ -56,12 +58,13 @@ contains
     integer, allocatable, SAVE :: a[:]
 
     if (init) then
-      if (allocated(a)) STOP 10
+      if (allocated(a)) STOP 11
       allocate(a[*])
       a = 45
    else
-      if (.not. allocated(a)) STOP 11
-      if (a /= 45) STOP 12
+      if (.not. allocated(a)) STOP 12
+      if (a /= 45) STOP 13
+      sync all
       deallocate(a)
     end if
   end subroutine two
diff --git a/gcc/testsuite/gfortran.dg/coarray/stopped_images_1.f08 b/gcc/testsuite/gfortran.dg/coarray/stopped_images_1.f08
index 403de58..7658e6b 100644
--- a/gcc/testsuite/gfortran.dg/coarray/stopped_images_1.f08
+++ b/gcc/testsuite/gfortran.dg/coarray/stopped_images_1.f08
@@ -8,7 +8,7 @@ program test_stopped_images_1
   integer :: i
 
   gi = stopped_images()         ! OK
-  gi = stopped_images(TEAM=1)   ! { dg-error "'team' argument of 'stopped_images' intrinsic at \\(1\\) not yet supported" }
+  gi = stopped_images(TEAM=1)   ! { dg-error "'team' argument of 'stopped_images' intrinsic at \\(1\\) shall be of type 'team_type' from the intrinsic module 'ISO_FORTRAN_ENV'" }
   gi = stopped_images(KIND=1)   ! OK
   gi = stopped_images(KIND=4)   ! OK
   gi = stopped_images(KIND=0)   ! { dg-error "'kind' argument of 'stopped_images' intrinsic at \\\(1\\\) must be positive" }
diff --git a/gcc/testsuite/gfortran.dg/coarray/stopped_images_2.f08 b/gcc/testsuite/gfortran.dg/coarray/stopped_images_2.f08
index 0bf4a81..dadd00e 100644
--- a/gcc/testsuite/gfortran.dg/coarray/stopped_images_2.f08
+++ b/gcc/testsuite/gfortran.dg/coarray/stopped_images_2.f08
@@ -1,17 +1,44 @@
 ! { dg-do run }
 
 program test_stopped_images_2
+  use iso_fortran_env
   implicit none
 
+  type(team_type) :: t
   integer, allocatable :: si(:)
   integer(kind=1), allocatable :: ssi(:)
+  integer, allocatable :: rem_images(:)
+  integer :: i, st
 
-  si = stopped_images()
-  if (size(si) > 0) error stop "stopped_images result shall be empty array"
-  ssi = stopped_images(KIND=1)
-  if (size(ssi) > 0) error stop "stopped_images result shall be empty array"
-  ssi = stopped_images(KIND=8)
-  if (size(ssi) > 0) error stop "stopped_images result shall be empty array"
+  associate(np => num_images())
+    form team (1, t)
+    si = stopped_images()
+    if (size(si) > 0) stop 1
+    ssi = stopped_images(KIND=1)
+    if (size(ssi) > 0) stop 2
+    ssi = stopped_images(KIND=8)
+    if (size(ssi) > 0) stop 3
+    
+    si = stopped_images(t)  
+    if (size(si) > 0) stop 4
   
+    if (num_images() > 1) then
+      sync all
+      if (this_image() == 2) stop
+      rem_images = (/ 1, ( i, i = 3, np )/)
+      ! Can't synchronize well on a stopped image.  Try with a sleep.
+      do i = 0, 10
+        if (size(stopped_images()) == 0) then
+          call sleep(1)
+        else
+          exit
+        end if
+      end do
+      if (i == 10 .AND. size(stopped_images()) == 0) stop 5
+      sync images (rem_images, stat=st)
+      if (any(stopped_images() /= [2])) stop 6
+      if (any(stopped_images(t, 8) /= [2])) stop 7
+    end if
+  end associate
 end program test_stopped_images_2
 
diff --git a/gcc/testsuite/gfortran.dg/coarray/sync_1.f90 b/gcc/testsuite/gfortran.dg/coarray/sync_1.f90
index 8633c4a..4abe5a3 100644
--- a/gcc/testsuite/gfortran.dg/coarray/sync_1.f90
+++ b/gcc/testsuite/gfortran.dg/coarray/sync_1.f90
@@ -26,7 +26,6 @@ n = 5
 sync all (stat=n,errmsg=str)
 if (n /= 0) STOP 2
 
-
 !
 ! Test SYNC MEMORY
 !
@@ -42,17 +41,21 @@ n = 5
 sync memory (errmsg=str,stat=n)
 if (n /= 0) STOP 4
 
-
 !
 ! Test SYNC IMAGES
 !
 sync images (*)
+
 if (this_image() == 1) then
     sync images (1)
     sync images (1, errmsg=str)
     sync images ([1])
 end if
 
+! Need to sync all here, because otherwise sync image 1 may overlap with the
+! sync images(*, stat=n) below and that may hang for num_images() > 1.
+sync all
+
 n = 5
 sync images (*, stat=n)
 if (n /= 0) STOP 5
@@ -61,4 +64,5 @@ n = 5
 sync images (*,errmsg=str,stat=n)
 if (n /= 0) STOP 6
 
+sync all
 end
diff --git a/gcc/testsuite/gfortran.dg/coarray/sync_3.f90 b/gcc/testsuite/gfortran.dg/coarray/sync_3.f90
index fe1e4c5..ceb4b19 100644
--- a/gcc/testsuite/gfortran.dg/coarray/sync_3.f90
+++ b/gcc/testsuite/gfortran.dg/coarray/sync_3.f90
@@ -9,8 +9,9 @@
 ! PR fortran/18918
 
 implicit none
-integer :: n
-character(len=30) :: str
+integer :: n, st
+integer,allocatable :: others(:)
+character(len=40) :: str
 critical
 end critical
 myCr: critical
@@ -58,17 +59,32 @@ if (this_image() == 1) then
     sync images ([1])
 end if
 
+! Need to sync all here, because otherwise sync image 1 may overlap with the
+! sync images(*, stat=n) below and that may hang for num_images() > 1.
+sync all
+
 n = 5
 sync images (*, stat=n)
 if (n /= 0) STOP 5
 
 n = 5
-sync images (*,errmsg=str,stat=n)
+sync images (*, errmsg=str, stat=n)
 if (n /= 0) STOP 6
 
+if (this_image() == num_images()) then
+  others = (/( n, n=1, (num_images() - 1)) /)
+  sync images(others)
+else
+  sync images ( num_images() )
+end if 
+
 n = -1
-sync images ( num_images() )
-sync images (n) ! Invalid: "-1"
+st = 0
+sync images (n, errmsg=str, stat=st)
+if (st /= 1 .OR. str /= "Invalid image number -1 in SYNC IMAGES") STOP 7
+
+! Do this only on image 1, or output of error messages will clutter
+if (this_image() == 1) sync images (n) ! Invalid: "-1"
 
 end
 
diff --git a/gcc/testsuite/gfortran.dg/coarray/sync_team.f90 b/gcc/testsuite/gfortran.dg/coarray/sync_team.f90
new file mode 100644
index 0000000..a968845
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/sync_team.f90
@@ -0,0 +1,33 @@
+!{ dg-do run }
+
+program main
+  use, intrinsic :: iso_fortran_env, only: team_type
+  implicit none
+  integer, parameter :: PARENT_TEAM = 1, CURRENT_TEAM = 2, CHILD_TEAM = 3
+  type(team_type) :: team(3)
+
+  if (num_images() > 7) then
+
+    form team (1, team(PARENT_TEAM))
+    change team (team(PARENT_TEAM))
+      form team (mod(this_image(),2) + 1, team(CURRENT_TEAM))
+      change team (team(CURRENT_TEAM))
+        form team(mod(this_image(),2) + 1, team(CHILD_TEAM))
+        sync team(team(PARENT_TEAM))
+        ! change order / number of syncs between teams to try to expose deadlocks
+        if (team_number() == 1) then
+           sync team(team(CURRENT_TEAM))
+           sync team(team(CHILD_TEAM))
+        else
+           sync team(team(CHILD_TEAM))
+           sync team(team(CURRENT_TEAM))
+           sync team(team(CHILD_TEAM))
+           sync team(team(CURRENT_TEAM))
+        end if
+      end team
+    end team
+
+    sync all
+  end if
+
+end program
diff --git a/gcc/testsuite/gfortran.dg/coarray_sync_memory.f90 b/gcc/testsuite/gfortran.dg/coarray_sync_memory.f90
index c4e660b..0030d91 100644
--- a/gcc/testsuite/gfortran.dg/coarray_sync_memory.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_sync_memory.f90
@@ -14,5 +14,5 @@ end
 
 ! { dg-final { scan-tree-dump-times "_gfortran_caf_sync_memory \\(0B, 0B, 0\\);" 1 "original" } }
 ! { dg-final { scan-tree-dump-times "_gfortran_caf_sync_memory \\(&stat, 0B, 0\\);" 1 "original" } }
-! { dg-final { scan-tree-dump-times "_gfortran_caf_sync_memory \\(0B, &&msg, 42\\);" 1 "original" } }
-! { dg-final { scan-tree-dump-times "_gfortran_caf_sync_memory \\(&stat, &&msg, 42\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_sync_memory \\(0B, &msg, 42\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_sync_memory \\(&stat, &msg, 42\\);" 1 "original" } }