1 files changed, 85 insertions, 5 deletions

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 9dd6071..20af75f 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -4552,7 +4552,7 @@ gfc_check_image_index (gfc_expr *coarray, gfc_expr *sub)
 
 
 bool
-gfc_check_this_image (gfc_expr *coarray, gfc_expr *dim)
+gfc_check_num_images (gfc_expr *distance, gfc_expr *failed)
 {
   if (gfc_option.coarray == GFC_FCOARRAY_NONE)
     {
@@ -4560,16 +4560,96 @@ gfc_check_this_image (gfc_expr *coarray, gfc_expr *dim)
       return false;
     }
 
-  if (dim != NULL &&  coarray == NULL)
+  if (distance)
     {
-      gfc_error ("DIM argument without ARRAY argument not allowed for THIS_IMAGE "
-                "intrinsic at %L", &dim->where);
+      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_F2008_TS, "DISTANCE= argument to "
+			   "NUM_IMAGES at %L", &distance->where))
+	return false;
+    }
+
+   if (failed)
+    {
+      if (!type_check (failed, 1, BT_LOGICAL))
+	return false;
+
+      if (!scalar_check (failed, 1))
+	return false;
+
+      if (!gfc_notify_std (GFC_STD_F2008_TS, "FAILED= argument to "
+			   "NUM_IMAGES at %L", &distance->where))
+	return false;
+    }
+
+  return true;
+}
+
+
+bool
+gfc_check_this_image (gfc_expr *coarray, gfc_expr *dim, gfc_expr *distance)
+{
+  if (gfc_option.coarray == GFC_FCOARRAY_NONE)
+    {
+      gfc_fatal_error ("Coarrays disabled at %C, use -fcoarray= to enable");
       return false;
     }
 
-  if (coarray == NULL)
+  if (coarray == NULL && dim == NULL && distance == NULL)
     return true;
 
+  if (dim != NULL && coarray == NULL)
+    {
+      gfc_error ("DIM argument without COARRAY argument not allowed for "
+		 "THIS_IMAGE intrinsic at %L", &dim->where);
+      return false;
+    }
+
+  if (distance && (coarray || dim))
+    {
+      gfc_error ("The DISTANCE argument may not be specified together with the "
+		 "COARRAY or DIM argument in intrinsic at %L",
+		 &distance->where);
+      return false;
+    }
+
+  /* Assume that we have "this_image (distance)".  */
+  if (coarray && !gfc_is_coarray (coarray) && coarray->ts.type == BT_INTEGER)
+    {
+      if (dim)
+	{
+	  gfc_error ("Unexpected DIM argument with noncoarray argument at %L",
+		     &coarray->where);
+	  return false;
+	}
+      distance = coarray;
+    }
+
+  if (distance)
+    {
+      if (!type_check (distance, 2, BT_INTEGER))
+	return false;
+
+      if (!nonnegative_check ("DISTANCE", distance))
+	return false;
+
+      if (!scalar_check (distance, 2))
+	return false;
+
+      if (!gfc_notify_std (GFC_STD_F2008_TS, "DISTANCE= argument to "
+			   "THIS_IMAGE at %L", &distance->where))
+	return false;
+
+      return true;
+    }
+
   if (!coarray_check (coarray, 0))
     return false;