check.c (gfc_check_num_images): New.

2014-05-25  Tobias Burnus  <burnus@net-b.de>

        * check.c (gfc_check_num_images): New.
        (gfc_check_this_image): Handle distance argument.
        * intrinsic.c (add_functions): Update this_image and num_images
        for new distance and failed arguments.
        * intrinsic.texi (THIS_IMAGE, NUM_IMAGES): Document the new
        arguments.
        * intrinsic.h (gfc_check_num_images): New.
        (gfc_check_this_image, gfc_simplify_num_images,
        gfc_simplify_this_image, gfc_resolve_this_image): Update prototype.
        * iresolve.c (gfc_resolve_this_image): Handle distance argument.
        * simplify.c (gfc_simplify_num_images, gfc_simplify_this_image):
        Handle new arguments.
        * trans-intrinsic.c (trans_this_image, trans_num_images): Ditto.
        (gfc_conv_intrinsic_function): Update trans_num_images call.

2014-05-25  Tobias Burnus  <burnus@net-b.de>

        * gfortran.dg/coarray_10.f90: Update dg-warning.
        * gfortran.dg/coarray_this_image_1.f90: New.
        * gfortran.dg/coarray_this_image_2.f90: New.

From-SVN: r210909

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;