Fortran: Add teams support in image_index and num_images for F2018

This more or less completes the set of functions that are affected by
teams.

gcc/fortran/ChangeLog:

	* check.cc (gfc_check_image_index): Check for team or
	team_number correctnes.
	(gfc_check_num_images): Same.
	* gfortran.texi: Update documentation on num_images' API
	function.
	* intrinsic.cc (add_functions): Update signature of image_index
	and num_images.  Both can take either a team handle or number.
	* intrinsic.h (gfc_check_num_images): Update signature to take
	either team or team_number.
	(gfc_check_image_index): Can take coarray, subscripts and team
	or team number now.
	(gfc_simplify_image_index): Same.
	(gfc_simplify_num_images): Same.
	(gfc_resolve_image_index): Same.
	* intrinsic.texi: Update documentation of num_images() Fortran
	function.
	* iresolve.cc (gfc_resolve_image_index): Update signature.
	* simplify.cc (gfc_simplify_num_images): Update signature and
	remove undocumented failed argument.
	(gfc_simplify_image_index): Add team or team number argument.
	* trans-intrinsic.cc (conv_stat_and_team): Because being
	optional teams need to be a pointer to the opaque pointer.
	(conv_caf_sendget): Correct call; was two arguments short.
	(trans_image_index): Support team or team_number.
	(trans_num_images): Same.
	(conv_intrinsic_cobound): Adapt to changed signature of
	num_images in call.
	* trans-stmt.cc (gfc_trans_sync): Same.

libgfortran/ChangeLog:

	* caf/libcaf.h (_gfortran_caf_num_images): Correct prototype.
	* caf/single.c (_gfortran_caf_num_images): Default
	implementation.

gcc/testsuite/ChangeLog:

	* gfortran.dg/coarray_49.f90: Adapt to changed error message.
	* gfortran.dg/coarray_collectives_12.f90: Adapt to changed
	function signature of num_images.
	* gfortran.dg/coarray_collectives_16.f90: Same.
	* gfortran.dg/coarray_lib_this_image_1.f90: Same.
	* gfortran.dg/coarray_lib_this_image_2.f90: Same.
	* gfortran.dg/coarray_this_image_1.f90: Adapt tests for
	num_images.
	* gfortran.dg/coarray_this_image_2.f90: Same.
	* gfortran.dg/coarray_this_image_3.f90: Same.
	* gfortran.dg/num_images_1.f90: Check that deprecated syntax is
	no longer supported.

18 files changed, 168 insertions, 172 deletions

diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index c27f653..356e0d7 100644
--- a/gcc/fortran/check.cc
+++ b/gcc/fortran/check.cc
@@ -6565,7 +6565,8 @@ gfc_check_stat_sub (gfc_expr *name, gfc_expr *array, gfc_expr *status)
 
 
 bool
-gfc_check_image_index (gfc_expr *coarray, gfc_expr *sub)
+gfc_check_image_index (gfc_expr *coarray, gfc_expr *sub,
+		       gfc_expr *team_or_team_number)
 {
   mpz_t nelems;
 
@@ -6585,12 +6586,8 @@ gfc_check_image_index (gfc_expr *coarray, gfc_expr *sub)
       return false;
     }
 
-  if (sub->ts.type != BT_INTEGER)
-    {
-      gfc_error ("Type of %s argument of IMAGE_INDEX at %L shall be INTEGER",
-		 gfc_current_intrinsic_arg[1]->name, &sub->where);
-      return false;
-    }
+  if (!type_check (sub, 1, BT_INTEGER))
+    return false;
 
   if (gfc_array_size (sub, &nelems))
     {
@@ -6605,12 +6602,23 @@ gfc_check_image_index (gfc_expr *coarray, gfc_expr *sub)
       mpz_clear (nelems);
     }
 
+  if (team_or_team_number)
+    {
+      if (!type_check2 (team_or_team_number, 2, BT_DERIVED, BT_INTEGER)
+	  || !scalar_check (team_or_team_number, 2))
+	return false;
+
+      /* Check team is of team_type.  */
+      if (team_or_team_number->ts.type == BT_DERIVED
+	  && !team_type_check (team_or_team_number, 2))
+	return false;
+    }
+
   return true;
 }
 
-
 bool
-gfc_check_num_images (gfc_expr *distance, gfc_expr *failed)
+gfc_check_num_images (gfc_expr *team_or_team_number)
 {
   if (flag_coarray == GFC_FCOARRAY_NONE)
     {
@@ -6618,34 +6626,21 @@ gfc_check_num_images (gfc_expr *distance, gfc_expr *failed)
       return false;
     }
 
-  if (distance)
-    {
-      if (!type_check (distance, 0, BT_INTEGER))
-	return false;
-
-      if (!nonnegative_check ("DISTANCE", distance))
-	return false;
-
-      if (!scalar_check (distance, 0))
-	return false;
-
-      if (!gfc_notify_std (GFC_STD_F2018, "DISTANCE= argument to "
-			   "NUM_IMAGES at %L", &distance->where))
-	return false;
-    }
+  if (!team_or_team_number)
+    return true;
 
-   if (failed)
-    {
-      if (!type_check (failed, 1, BT_LOGICAL))
-	return false;
+  if (!gfc_notify_std (GFC_STD_F2008,
+		       "%<team%> or %<team_number%> argument to %qs at %L",
+		       gfc_current_intrinsic, &team_or_team_number->where))
+    return false;
 
-      if (!scalar_check (failed, 1))
-	return false;
+  if (!type_check2 (team_or_team_number, 0, BT_DERIVED, BT_INTEGER)
+      || !scalar_check (team_or_team_number, 0))
+    return false;
 
-      if (!gfc_notify_std (GFC_STD_F2018, "FAILED= argument to "
-			   "NUM_IMAGES at %L", &failed->where))
-	return false;
-    }
+  if (team_or_team_number->ts.type == BT_DERIVED
+      && !team_type_check (team_or_team_number, 0))
+    return false;
 
   return true;
 }
diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index 33ac6d4..841f613 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -4326,25 +4326,29 @@ be null here.
 
 @table @asis
 @item @emph{Synopsis}:
-@code{int _gfortran_caf_num_images(int distance, int failed)}
+@code{int _gfortran_caf_num_images (caf_team_t team, int32_t *team_number)}
 
 @item @emph{Description}:
-This function returns the number of images in the current team, if
-@var{distance} is 0 or the number of images in the parent team at the specified
-distance. If @var{failed} is -1, the function returns the number of all images at
-the specified distance; if it is 0, the function returns the number of
-nonfailed images, and if it is 1, it returns the number of failed images.
+This function returns the number of images in the team given by @var{team} or
+@var{team_number}, if either one is present.  If both are null, then the number
+of images in the current team is returned.
 
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
-@item @var{distance} @tab the distance from this image to the ancestor.
-Shall be positive.
-@item @var{failed} @tab shall be -1, 0, or 1
+@item @var{team} @tab intent(in), optional; The team the number of images is
+requested for.  If null, the number of images in the current team is returned.
+@item @var{team_number} @tab intent(in), optional; The team id for which the
+number of teams is requested; if unset, then number of images in the current
+team is returned.
 @end multitable
 
 @item @emph{Notes}:
-This function follows TS18508. If the num_image intrinsic has no arguments,
-then the compiler passes @code{distance=0} and @code{failed=-1} to the function.
+When both argument are given, then it is caf-library dependent which argument
+is examined first.  Current implementations prioritize the @var{team} argument,
+because it is easier to retrive the number of images from it.
+
+Fortran 2008 or later, with no arguments; Fortran 2018 or later with two
+arguments.
 @end table
 
 
diff --git a/gcc/fortran/intrinsic.cc b/gcc/fortran/intrinsic.cc
index ce586a2..2eba209 100644
--- a/gcc/fortran/intrinsic.cc
+++ b/gcc/fortran/intrinsic.cc
@@ -1395,26 +1395,24 @@ add_functions (void)
 {
   /* Argument names.  These are used as argument keywords and so need to
     match the documentation.  Please keep this list in sorted order.  */
-  const char
-    *a = "a", *a1 = "a1", *a2 = "a2", *ar = "array", *b = "b",
-    *bck = "back", *bd = "boundary", *c = "c", *c_ptr_1 = "c_ptr_1",
-    *c_ptr_2 = "c_ptr_2", *ca = "coarray", *com = "command",
-    *dist = "distance", *dm = "dim", *f = "field", *failed="failed",
-    *fs = "fsource", *han = "handler", *i = "i",
-    *idy = "identity", *image = "image", *j = "j", *kind = "kind",
-    *l = "l", *ln = "len", *level = "level", *m = "matrix", *ma = "matrix_a",
-    *mb = "matrix_b", *md = "mode", *mo = "mold", *msk = "mask",
-    *n = "n", *ncopies= "ncopies", *nm = "name", *num = "number",
-    *op = "operation", *ord = "order", *odd = "ordered", *p = "p",
-	*p1 = "path1", *p2 = "path2", *pad = "pad", *pid = "pid", *pos = "pos",
-	*pt = "pointer", *r = "r", *rd = "round",
-    *s = "s", *set = "set", *sh = "shift", *shp = "shape",
-    *sig = "sig", *src = "source", *ssg = "substring",
-    *sta = "string_a", *stb = "string_b", *stg = "string",
-    *sub = "sub", *sz = "size", *tg = "target", *team = "team", *tm = "time",
-    *ts = "tsource", *ut = "unit", *v = "vector", *va = "vector_a",
-    *vb = "vector_b", *vl = "values", *val = "value", *x = "x", *y = "y",
-    *z = "z";
+  const char *a
+    = "a",
+    *a1 = "a1", *a2 = "a2", *ar = "array", *b = "b", *bck = "back",
+    *bd = "boundary", *c = "c", *c_ptr_1 = "c_ptr_1", *c_ptr_2 = "c_ptr_2",
+    *ca = "coarray", *com = "command", *dm = "dim", *f = "field",
+    *fs = "fsource", *han = "handler", *i = "i", *idy = "identity",
+    *image = "image", *j = "j", *kind = "kind", *l = "l", *ln = "len",
+    *level = "level", *m = "matrix", *ma = "matrix_a", *mb = "matrix_b",
+    *md = "mode", *mo = "mold", *msk = "mask", *n = "n", *ncopies = "ncopies",
+    *nm = "name", *num = "number", *op = "operation", *ord = "order",
+    *odd = "ordered", *p = "p", *p1 = "path1", *p2 = "path2", *pad = "pad",
+    *pid = "pid", *pos = "pos", *pt = "pointer", *r = "r", *rd = "round",
+    *s = "s", *set = "set", *sh = "shift", *shp = "shape", *sig = "sig",
+    *src = "source", *ssg = "substring", *sta = "string_a", *stb = "string_b",
+    *stg = "string", *sub = "sub", *sz = "size", *tg = "target", *team = "team",
+    *team_or_team_number = "team/team_number", *tm = "time", *ts = "tsource",
+    *ut = "unit", *v = "vector", *va = "vector_a", *vb = "vector_b",
+    *vl = "values", *val = "value", *x = "x", *y = "y", *z = "z";
 
   int di, dr, dd, dl, dc, dz, ii;
 
@@ -2265,9 +2263,11 @@ add_functions (void)
 
   make_generic ("ierrno", GFC_ISYM_IERRNO, GFC_STD_GNU);
 
-  add_sym_2 ("image_index", GFC_ISYM_IMAGE_INDEX, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008,
-	     gfc_check_image_index, gfc_simplify_image_index, gfc_resolve_image_index,
-	     ca, BT_REAL, dr, REQUIRED, sub, BT_INTEGER, ii, REQUIRED);
+  add_sym_3 ("image_index", GFC_ISYM_IMAGE_INDEX, CLASS_TRANSFORMATIONAL,
+	     ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008, gfc_check_image_index,
+	     gfc_simplify_image_index, gfc_resolve_image_index, ca, BT_REAL, dr,
+	     REQUIRED, sub, BT_INTEGER, ii, REQUIRED, team_or_team_number,
+	     BT_VOID, di, OPTIONAL);
 
   add_sym_2 ("image_status", GFC_ISYM_IMAGE_STATUS, CLASS_ELEMENTAL, ACTUAL_NO,
 	     BT_INTEGER, di, GFC_STD_F2018, gfc_check_image_status,
@@ -2848,11 +2848,10 @@ add_functions (void)
 
   make_generic ("null", GFC_ISYM_NULL, GFC_STD_F95);
 
-  add_sym_2 ("num_images", GFC_ISYM_NUM_IMAGES, CLASS_TRANSFORMATIONAL,
-	     ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008,
-	     gfc_check_num_images, gfc_simplify_num_images, NULL,
-	     dist, BT_INTEGER, di, OPTIONAL,
-	     failed, BT_LOGICAL, dl, OPTIONAL);
+  add_sym_1 ("num_images", GFC_ISYM_NUM_IMAGES, CLASS_TRANSFORMATIONAL,
+	     ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008, gfc_check_num_images,
+	     gfc_simplify_num_images, NULL, team_or_team_number, BT_VOID, di,
+	     OPTIONAL);
 
   add_sym_3 ("out_of_range", GFC_ISYM_OUT_OF_RANGE, CLASS_ELEMENTAL, ACTUAL_NO,
 	     BT_LOGICAL, dl, GFC_STD_F2018,
diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h
index 3a702b3..767792c 100644
--- a/gcc/fortran/intrinsic.h
+++ b/gcc/fortran/intrinsic.h
@@ -132,7 +132,7 @@ bool gfc_check_nearest (gfc_expr *, gfc_expr *);
 bool gfc_check_new_line (gfc_expr *);
 bool gfc_check_norm2 (gfc_expr *, gfc_expr *);
 bool gfc_check_null (gfc_expr *);
-bool gfc_check_num_images (gfc_expr *, gfc_expr *);
+bool gfc_check_num_images (gfc_expr *);
 bool gfc_check_out_of_range (gfc_expr *, gfc_expr *, gfc_expr *);
 bool gfc_check_pack (gfc_expr *, gfc_expr *, gfc_expr *);
 bool gfc_check_parity (gfc_expr *, gfc_expr *);
@@ -222,7 +222,7 @@ bool gfc_check_fseek_sub (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 bool gfc_check_ftell_sub (gfc_expr *, gfc_expr *);
 bool gfc_check_getcwd_sub (gfc_expr *, gfc_expr *);
 bool gfc_check_hostnm_sub (gfc_expr *, gfc_expr *);
-bool gfc_check_image_index (gfc_expr *, gfc_expr *);
+bool gfc_check_image_index (gfc_expr *, gfc_expr *, gfc_expr *);
 bool gfc_check_itime_idate (gfc_expr *);
 bool gfc_check_kill_sub (gfc_expr *, gfc_expr *, gfc_expr *);
 bool gfc_check_ltime_gmtime (gfc_expr *, gfc_expr *);
@@ -328,7 +328,7 @@ gfc_expr *gfc_simplify_ibits (gfc_expr *, gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_ibset (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_ichar (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_ieor (gfc_expr *, gfc_expr *);
-gfc_expr *gfc_simplify_image_index (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_image_index (gfc_expr *, gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_image_status (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_index (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_int (gfc_expr *, gfc_expr *);
@@ -383,7 +383,7 @@ gfc_expr *gfc_simplify_new_line (gfc_expr *);
 gfc_expr *gfc_simplify_nint (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_norm2 (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_null (gfc_expr *);
-gfc_expr *gfc_simplify_num_images (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_num_images (gfc_expr *);
 gfc_expr *gfc_simplify_idnint (gfc_expr *);
 gfc_expr *gfc_simplify_not (gfc_expr *);
 gfc_expr *gfc_simplify_or (gfc_expr *, gfc_expr *);
@@ -531,7 +531,7 @@ void gfc_resolve_iand (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_ibclr (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_ibits (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_ibset (gfc_expr *, gfc_expr *, gfc_expr *);
-void gfc_resolve_image_index (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_image_index (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_image_status (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_index_func (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
 			     gfc_expr *);
diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index 365e61b..3a105bc 100644
--- a/gcc/fortran/intrinsic.texi
+++ b/gcc/fortran/intrinsic.texi
@@ -11427,47 +11427,48 @@ Fortran 95 and later
 
 @table @asis
 @item @emph{Synopsis}:
-@code{RESULT = NUM_IMAGES(DISTANCE, FAILED)}
+@multitable @columnfractions .80
+@item @code{RESULT = NUM_IMAGES([TEAM])}
+@item @code{RESULT = NUM_IMAGES(TEAM_NUMBER)}
+@end multitable
 
 @item @emph{Description}:
-Returns the number of images.
+Returns the number of images in the current team or the given team.
 
 @item @emph{Class}:
 Transformational function
 
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
-@item @var{DISTANCE} @tab (optional, intent(in)) Nonnegative scalar integer
-@item @var{FAILED}   @tab (optional, intent(in)) Scalar logical expression
+@item @var{TEAM} @tab (optional, intent(in)) If present, return the number of
+images in the given team; if absent, return the number of images in the
+current team.
+@item @var{TEAM_NUMBER} @tab (intent(in)) The number as given in the
+@code{FORM TEAM} statement.
 @end multitable
 
 @item @emph{Return value}:
-Scalar default-kind integer.  If @var{DISTANCE} is not present or has value 0,
-the number of images in the current team is returned. For values smaller or
-equal distance to the initial team, it returns the number of images index
-on the ancestor team that has a distance of @var{DISTANCE} from the invoking
-team. If @var{DISTANCE} is larger than the distance to the initial team, the
-number of images of the initial team is returned. If @var{FAILED} is not present
-the total number of images is returned; if it has the value @code{.TRUE.},
-the number of failed images is returned, otherwise, the number of images that
-do have not the failed status.
+Scalar default-kind integer.  Can be called without any arguments or a team
+type argument or a team_number argument.
 
 @item @emph{Example}:
 @smallexample
+use, intrinsic :: iso_fortran_env
 INTEGER :: value[*]
 INTEGER :: i
-value = THIS_IMAGE()
-SYNC ALL
-IF (THIS_IMAGE() == 1) THEN
-  DO i = 1, NUM_IMAGES()
-    WRITE(*,'(2(a,i0))') 'value[', i, '] is ', value[i]
-  END DO
-END IF
+type(team_type) :: t
+
+! When running with 4 images
+print *, num_images() ! 4
+
+form team (mod(this_image(), 2), t)
+print *, num_images(t) ! 2
+print *, num_images(-1) ! 4
 @end smallexample
 
 @item @emph{Standard}:
-Fortran 2008 and later. With @var{DISTANCE} or @var{FAILED} argument, 
-Technical Specification (TS) 18508 or later
+Fortran 2008 and later.  With @var{TEAM} or @var{TEAM_NUMBER} argument,
+Fortran 2018 and later.
 
 @item @emph{See also}:
 @ref{THIS_IMAGE}, @*
diff --git a/gcc/fortran/iresolve.cc b/gcc/fortran/iresolve.cc
index c286c2a..6930e2c 100644
--- a/gcc/fortran/iresolve.cc
+++ b/gcc/fortran/iresolve.cc
@@ -3229,7 +3229,8 @@ gfc_resolve_get_team (gfc_expr *f, gfc_expr *level ATTRIBUTE_UNUSED)
 
 void
 gfc_resolve_image_index (gfc_expr *f, gfc_expr *array ATTRIBUTE_UNUSED,
-			 gfc_expr *sub ATTRIBUTE_UNUSED)
+			 gfc_expr *sub ATTRIBUTE_UNUSED,
+			 gfc_expr *team_or_team_number ATTRIBUTE_UNUSED)
 {
   static char image_index[] = "__image_index";
   f->ts.type = BT_INTEGER;
diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc
index b94eb43..208251b 100644
--- a/gcc/fortran/simplify.cc
+++ b/gcc/fortran/simplify.cc
@@ -6729,7 +6729,7 @@ gfc_simplify_null (gfc_expr *mold)
 
 
 gfc_expr *
-gfc_simplify_num_images (gfc_expr *distance ATTRIBUTE_UNUSED, gfc_expr *failed)
+gfc_simplify_num_images (gfc_expr *team_or_team_number ATTRIBUTE_UNUSED)
 {
   gfc_expr *result;
 
@@ -6742,16 +6742,9 @@ gfc_simplify_num_images (gfc_expr *distance ATTRIBUTE_UNUSED, gfc_expr *failed)
   if (flag_coarray != GFC_FCOARRAY_SINGLE)
     return NULL;
 
-  if (failed && failed->expr_type != EXPR_CONSTANT)
-    return NULL;
-
   /* FIXME: gfc_current_locus is wrong.  */
   result = gfc_get_constant_expr (BT_INTEGER, gfc_default_integer_kind,
 				  &gfc_current_locus);
-
-  if (failed && failed->value.logical != 0)
-    mpz_set_si (result->value.integer, 0);
-  else
     mpz_set_si (result->value.integer, 1);
 
   return result;
@@ -8927,7 +8920,8 @@ gfc_simplify_trim (gfc_expr *e)
 
 
 gfc_expr *
-gfc_simplify_image_index (gfc_expr *coarray, gfc_expr *sub)
+gfc_simplify_image_index (gfc_expr *coarray, gfc_expr *sub,
+			  gfc_expr *team_or_team_number ATTRIBUTE_UNUSED)
 {
   gfc_expr *result;
   gfc_ref *ref;
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 01c1995..f388ba5 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -1184,7 +1184,9 @@ 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);
-      *team = team_se.expr;
+      *team
+	= gfc_build_addr_expr (NULL_TREE, gfc_trans_force_lval (&team_se.pre,
+								team_se.expr));
       gfc_add_block_to_block (block, &team_se.pre);
       gfc_add_block_to_block (block, &team_se.post);
     }
@@ -1197,7 +1199,10 @@ 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);
-      *team_no = team_se.expr;
+      *team_no = gfc_build_addr_expr (
+	NULL_TREE,
+	gfc_trans_force_lval (&team_se.pre,
+			      fold_convert (integer_type_node, team_se.expr)));
       gfc_add_block_to_block (block, &team_se.pre);
       gfc_add_block_to_block (block, &team_se.post);
     }
@@ -1790,13 +1795,13 @@ conv_caf_sendget (gfc_code *code)
   ++caf_call_cnt;
 
   tmp = build_call_expr_loc (
-    input_location, gfor_fndecl_caf_transfer_between_remotes, 20, lhs_token,
+    input_location, gfor_fndecl_caf_transfer_between_remotes, 22, lhs_token,
     opt_lhs_desc, opt_lhs_charlen, lhs_image_index, receiver_fn_index_tree,
     lhs_add_data_tree, lhs_add_data_size, rhs_token, opt_rhs_desc,
     opt_rhs_charlen, rhs_image_index, sender_fn_index_tree, rhs_add_data_tree,
     rhs_add_data_size, rhs_size,
     transfer_rank == 0 ? boolean_true_node : boolean_false_node, lhs_stat,
-    lhs_team, lhs_team_no, rhs_stat, rhs_team, rhs_team_no);
+    rhs_stat, lhs_team, lhs_team_no, rhs_team, rhs_team_no);
 
   gfc_add_expr_to_block (&block, tmp);
   gfc_add_block_to_block (&block, &lhs_se.post);
@@ -2112,8 +2117,8 @@ conv_intrinsic_team_number (gfc_se *se, gfc_expr *expr)
 static void
 trans_image_index (gfc_se * se, gfc_expr *expr)
 {
-  tree num_images, cond, coindex, type, lbound, ubound, desc, subdesc,
-       tmp, invalid_bound;
+  tree num_images, cond, coindex, type, lbound, ubound, desc, subdesc, tmp,
+    invalid_bound, team = null_pointer_node, team_number = null_pointer_node;
   gfc_se argse, subse;
   int rank, corank, codim;
 
@@ -2137,6 +2142,22 @@ trans_image_index (gfc_se * se, gfc_expr *expr)
   subdesc = build_fold_indirect_ref_loc (input_location,
 			gfc_conv_descriptor_data_get (subse.expr));
 
+  if (expr->value.function.actual->next->next->expr)
+    {
+      gfc_init_se (&argse, NULL);
+      gfc_conv_expr_descriptor (&argse,
+				expr->value.function.actual->next->next->expr);
+      if (expr->value.function.actual->next->next->expr->ts.type == BT_DERIVED)
+	team = argse.expr;
+      else
+	team_number = gfc_build_addr_expr (
+	  NULL_TREE,
+	  gfc_trans_force_lval (&argse.pre,
+				fold_convert (integer_type_node, argse.expr)));
+      gfc_add_block_to_block (&se->pre, &argse.pre);
+      gfc_add_block_to_block (&se->post, &argse.post);
+    }
+
   /* Fortran 2008 does not require that the values remain in the cobounds,
      thus we need explicitly check this - and return 0 if they are exceeded.  */
 
@@ -2212,8 +2233,7 @@ trans_image_index (gfc_se * se, gfc_expr *expr)
   else
     {
       tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_num_images, 2,
-				 integer_zero_node,
-				 build_int_cst (integer_type_node, -1));
+				 team, team_number);
       num_images = fold_convert (type, tmp);
     }
 
@@ -2232,32 +2252,26 @@ trans_image_index (gfc_se * se, gfc_expr *expr)
 static void
 trans_num_images (gfc_se * se, gfc_expr *expr)
 {
-  tree tmp, distance, failed;
+  tree tmp, team = null_pointer_node, team_number = null_pointer_node;
   gfc_se argse;
 
   if (expr->value.function.actual->expr)
     {
       gfc_init_se (&argse, NULL);
       gfc_conv_expr_val (&argse, expr->value.function.actual->expr);
+      if (expr->value.function.actual->expr->ts.type == BT_DERIVED)
+	team = argse.expr;
+      else
+	team_number = gfc_build_addr_expr (
+	  NULL_TREE,
+	  gfc_trans_force_lval (&se->pre,
+				fold_convert (integer_type_node, argse.expr)));
       gfc_add_block_to_block (&se->pre, &argse.pre);
       gfc_add_block_to_block (&se->post, &argse.post);
-      distance = fold_convert (integer_type_node, argse.expr);
     }
-  else
-    distance = integer_zero_node;
 
-  if (expr->value.function.actual->next->expr)
-    {
-      gfc_init_se (&argse, NULL);
-      gfc_conv_expr_val (&argse, expr->value.function.actual->next->expr);
-      gfc_add_block_to_block (&se->pre, &argse.pre);
-      gfc_add_block_to_block (&se->post, &argse.post);
-      failed = fold_convert (integer_type_node, argse.expr);
-    }
-  else
-    failed = build_int_cst (integer_type_node, -1);
   tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_num_images, 2,
-			     distance, failed);
+			     team, team_number);
   se->expr = fold_convert (gfc_get_int_type (gfc_default_integer_kind), tmp);
 }
 
@@ -2687,8 +2701,7 @@ conv_intrinsic_cobound (gfc_se * se, gfc_expr * expr)
 
 	  cosize = gfc_conv_descriptor_cosize (desc, arg->expr->rank, corank);
 	  tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_num_images,
-				     2, integer_zero_node,
-				     build_int_cst (integer_type_node, -1));
+				     2, null_pointer_node, null_pointer_node);
 	  tmp = fold_build2_loc (input_location, MINUS_EXPR,
 				 gfc_array_index_type,
 				 fold_convert (gfc_array_index_type, tmp),
@@ -2703,8 +2716,7 @@ conv_intrinsic_cobound (gfc_se * se, gfc_expr * expr)
 	{
 	  /* ubound = lbound + num_images() - 1.  */
 	  tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_num_images,
-				     2, integer_zero_node,
-				     build_int_cst (integer_type_node, -1));
+				     2, null_pointer_node, null_pointer_node);
 	  tmp = fold_build2_loc (input_location, MINUS_EXPR,
 				 gfc_array_index_type,
 				 fold_convert (gfc_array_index_type, tmp),
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index f128b4c..11fc1a8 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -1337,8 +1337,7 @@ gfc_trans_sync (gfc_code *code, gfc_exec_op type)
 	{
 	  tree cond2;
 	  tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_num_images,
-				     2, integer_zero_node,
-				     build_int_cst (integer_type_node, -1));
+				     2, null_pointer_node, null_pointer_node);
 	  cond = fold_build2_loc (input_location, GT_EXPR, logical_type_node,
 				  images2, tmp);
 	  cond2 = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
diff --git a/gcc/testsuite/gfortran.dg/coarray_49.f90 b/gcc/testsuite/gfortran.dg/coarray_49.f90
index 370e3fd..fd8549b 100644
--- a/gcc/testsuite/gfortran.dg/coarray_49.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_49.f90
@@ -5,5 +5,5 @@
 
 program p
   integer :: x[*]
-  print *, image_index (x, [1.0]) ! { dg-error "shall be INTEGER" }
+  print *, image_index (x, [1.0]) ! { dg-error "must be INTEGER" }
 end
diff --git a/gcc/testsuite/gfortran.dg/coarray_collectives_12.f90 b/gcc/testsuite/gfortran.dg/coarray_collectives_12.f90
index 299ea62..2d8a39a 100644
--- a/gcc/testsuite/gfortran.dg/coarray_collectives_12.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_collectives_12.f90
@@ -20,6 +20,6 @@ program test
   call co_broadcast(val3, source_image=res,stat=stat3, errmsg=errmesg3)
 end program test
 
-! { dg-final { scan-tree-dump-times "_gfortran_caf_co_broadcast \\(&desc.., _gfortran_caf_num_images \\(0, -1\\), &stat1, errmesg1, 6\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_co_broadcast \\(&desc.., _gfortran_caf_num_images \\(0B, 0B\\), &stat1, errmesg1, 6\\);" 1 "original" } }
 ! { dg-final { scan-tree-dump-times "_gfortran_caf_co_broadcast \\(&val2, 4, &stat2, errmesg2, 7\\);" 1 "original" } }
 ! { dg-final { scan-tree-dump-times "_gfortran_caf_co_broadcast \\(&desc.., res, &stat3, errmesg3, 8\\);" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/coarray_collectives_16.f90 b/gcc/testsuite/gfortran.dg/coarray_collectives_16.f90
index 8419cf9..05a1350 100644
--- a/gcc/testsuite/gfortran.dg/coarray_collectives_16.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_collectives_16.f90
@@ -33,6 +33,6 @@ contains
   end function hc
 end program test
 
-! { dg-final { scan-tree-dump-times "_gfortran_caf_co_reduce \\(&desc.., fr, 4, _gfortran_caf_num_images \\(0, -1\\), &stat1, errmesg1, 0, 6\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_co_reduce \\(&desc.., fr, 4, _gfortran_caf_num_images \\(0B, 0B\\), &stat1, errmesg1, 0, 6\\);" 1 "original" } }
 ! { dg-final { scan-tree-dump-times "_gfortran_caf_co_reduce \\(&val2, gz, 0, 4, &stat2, errmesg2, 0, 7\\);" 1 "original" } }
 ! { dg-final { scan-tree-dump-times "_gfortran_caf_co_reduce \\(&desc.., hc, 1, res, &stat3, errmesg3, 99, 8\\);" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/coarray_lib_this_image_1.f90 b/gcc/testsuite/gfortran.dg/coarray_lib_this_image_1.f90
index a38c230..7939a79 100644
--- a/gcc/testsuite/gfortran.dg/coarray_lib_this_image_1.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_lib_this_image_1.f90
@@ -19,7 +19,7 @@ end
 ! { dg-final { scan-tree-dump-times "bar \\(real\\(kind=4\\)\\\[2\\\] \\* restrict x, void \\* restrict caf_token.., integer\\(kind=\[48\]\\) caf_offset..\\)" 1 "original" } }
 ! { dg-final { scan-tree-dump-times "mylcobound = 5;" 1 "original" } }
 ! { dg-final { scan-tree-dump-times "parm...dim\\\[1\\\].lbound = 5;" 1 "original" } }
-! { dg-final { scan-tree-dump-times "myucobound =\[^\n\r\]* parm...dim\\\[1\\\].lbound \\+ \[^\n\r]*_gfortran_caf_num_images \\(0, -1\\).? \\+ -?\[0-9\]+\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "myucobound =\[^\n\r\]* parm...dim\\\[1\\\].lbound \\+ \[^\n\r]*_gfortran_caf_num_images \\(0B, 0B\\).? \\+ -?\[0-9\]+\\);" 1 "original" } }
 ! { dg-final { scan-tree-dump-times "mylbound = 1;" 1 "original" } }
 ! { dg-final { scan-tree-dump-times "mythis_image = _gfortran_caf_this_image \\(0B\\);" 1 "original" } }
 ! { dg-final { scan-tree-dump-times "bar \\(x, caf_token.., 0\\);" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/coarray_lib_this_image_2.f90 b/gcc/testsuite/gfortran.dg/coarray_lib_this_image_2.f90
index 3b504f5..31a7677 100644
--- a/gcc/testsuite/gfortran.dg/coarray_lib_this_image_2.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_lib_this_image_2.f90
@@ -19,7 +19,7 @@ end
 ! { dg-final { scan-tree-dump-times "bar \\(struct array02_real\\(kind=4\\) & restrict x, void \\* restrict caf_token.., integer\\(kind=\[48\]\\) caf_offset..\\)" 1 "original" } }
 ! { dg-final { scan-tree-dump-times "mylcobound = 5;" 1 "original" } }
 ! { dg-final { scan-tree-dump-times "parm...dim\\\[1\\\].lbound = 5;" 1 "original" } }
-! { dg-final { scan-tree-dump-times "myucobound =\[^\n\r\]* parm...dim\\\[1\\\].lbound \\+ \[^\n\r\]*_gfortran_caf_num_images \\(0, -1\\).? \\+ -?\[0-9\]+\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "myucobound =\[^\n\r\]* parm...dim\\\[1\\\].lbound \\+ \[^\n\r\]*_gfortran_caf_num_images \\(0B, 0B\\).? \\+ -?\[0-9\]+\\);" 1 "original" } }
 ! { dg-final { scan-tree-dump-times "mylbound = 1;" 1 "original" } }
 ! { dg-final { scan-tree-dump-times "mythis_image = _gfortran_caf_this_image \\(0B\\);" 1 "original" } }
 ! { dg-final { scan-tree-dump-times "bar \\(&parm.\[0-9\]+, caf_token.\[0-9\]+, \\(integer\\(kind=\[48\]\\)\\) parm.\[0-9\]+.data - \\(integer\\(kind=\[48\]\\)\\) x\\);" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/coarray_this_image_1.f90 b/gcc/testsuite/gfortran.dg/coarray_this_image_1.f90
index 779b056..5a609d8 100644
--- a/gcc/testsuite/gfortran.dg/coarray_this_image_1.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_this_image_1.f90
@@ -41,16 +41,12 @@ endif
 associate(me => this_image())
 end associate
 k1 = num_images()
-k2 = num_images(6)
-k3 = num_images(distance=7)
-k4 = num_images(distance=8, failed=.true.)
-k5 = num_images(failed=.false.)
+k2 = num_images(team)
+k3 = num_images(-1)
 end
 
 ! { dg-final { scan-tree-dump-times "j\[1-4\] = 1;" 4 "original" } }
 ! { dg-final { scan-tree-dump-times "A\\.\[0-9\]+\\\[2\\\] = \\\{1, 1\\\};" 4 "original" } }
-! { dg-final { scan-tree-dump-times "k1 = 1;" 1 "original" } }
-! { dg-final { scan-tree-dump-times "k2 = 1;" 1 "original" } }
-! { dg-final { scan-tree-dump-times "k3 = 1;" 1 "original" } }
-! { dg-final { scan-tree-dump-times "k4 = 0;" 1 "original" } }
-! { dg-final { scan-tree-dump-times "k5 = 1;" 1 "original" } }
+! { dg-final { scan-tree-dump "k1 = 1;" "original" } }
+! { dg-final { scan-tree-dump "k2 = 1;" "original" } }
+! { dg-final { scan-tree-dump "k3 = 1;" "original" } }
diff --git a/gcc/testsuite/gfortran.dg/coarray_this_image_2.f90 b/gcc/testsuite/gfortran.dg/coarray_this_image_2.f90
index d977e21..9713e3d 100644
--- a/gcc/testsuite/gfortran.dg/coarray_this_image_2.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_this_image_2.f90
@@ -42,18 +42,16 @@ if (j4 /= 1) then
 endif
 end associate
 k1 = num_images()
-k2 = num_images(6)
-k3 = num_images(distance=7)
-k4 = num_images(distance=8, failed=.true.)
-k5 = num_images(failed=.false.)
+k2 = num_images(team)
+k3 = num_images(-1)
+k4 = num_images(1)
 end
 
 ! { dg-final { scan-tree-dump "j1 = _gfortran_caf_this_image \\(0B\\);" "original" } }
 ! { dg-final { scan-tree-dump "j3 = _gfortran_caf_this_image \\(team\\);" "original" } }
 ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = _gfortran_caf_this_image \\(team\\) \\+ -1;" 2 "original" } }
 ! { dg-final { scan-tree-dump-times "D\\.\[0-9\]+ = _gfortran_caf_this_image \\(0B\\) \\+ -1;" 2 "original" } }
-! { dg-final { scan-tree-dump-times "k1 = _gfortran_caf_num_images \\(0, -1\\);" 1 "original" } }
-! { dg-final { scan-tree-dump-times "k2 = _gfortran_caf_num_images \\(6, -1\\);" 1 "original" } }
-! { dg-final { scan-tree-dump-times "k3 = _gfortran_caf_num_images \\(7, -1\\);" 1 "original" } }
-! { dg-final { scan-tree-dump-times "k4 = _gfortran_caf_num_images \\(8, 1\\);" 1 "original" } }
-! { dg-final { scan-tree-dump-times "k5 = _gfortran_caf_num_images \\(0, 0\\);" 1 "original" } }
+! { dg-final { scan-tree-dump "k1 = _gfortran_caf_num_images \\(0B, 0B\\);" "original" } }
+! { dg-final { scan-tree-dump "k2 = _gfortran_caf_num_images \\(team, 0B\\);"  "original" } }
+! { dg-final { scan-tree-dump "k3 = _gfortran_caf_num_images \\(0B, &D\\.\[0-9\]+\\);" "original" } }
+! { dg-final { scan-tree-dump "k4 = _gfortran_caf_num_images \\(0B, &D\\.\[0-9\]+\\);" "original" } }
diff --git a/gcc/testsuite/gfortran.dg/coarray_this_image_3.f90 b/gcc/testsuite/gfortran.dg/coarray_this_image_3.f90
index d346481..b8433b2 100644
--- a/gcc/testsuite/gfortran.dg/coarray_this_image_3.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_this_image_3.f90
@@ -22,13 +22,10 @@ j4 = this_image(caf, 1, team) ! ok
 j5 = this_image(caf, 1, team, 'baz') !{ dg-error "Too many arguments in call" }
 j6 = this_image(dim=1, team=team, coarray=caf)
 
-!k1 = num_images()
-
-!k2 = num_images(6)
-
-!k3 = num_images(distance=7)
-
-!k4 = num_images(distance=8, failed=.true.)
-
-!k5 = num_images(failed=.false.)
+k1 = num_images() ! ok
+k2 = num_images(team) ! ok
+k3 = num_images(team, 2) !{ dg-error "Too many arguments in call to" }
+k4 = num_images(1) ! ok
+k5 = num_images('abc') !{ dg-error "'team/team_number' argument of 'num_images' intrinsic" }
+k6 = num_images(1, team) !{ dg-error "Too many arguments in call to" }
 end
diff --git a/gcc/testsuite/gfortran.dg/num_images_1.f90 b/gcc/testsuite/gfortran.dg/num_images_1.f90
index dac34ba..e03857c 100644
--- a/gcc/testsuite/gfortran.dg/num_images_1.f90
+++ b/gcc/testsuite/gfortran.dg/num_images_1.f90
@@ -5,5 +5,5 @@
 program foo
    implicit none
    integer k5
-   k5 = num_images(failed=.false.) ! { dg-error "argument to NUM_IMAGES" }
+   k5 = num_images(failed=.false.) ! { dg-error "Cannot find keyword named 'failed' in call to 'num_images'" }
 end program foo