check.c (positive_check): Add new function checking constant for being greater then zero.

gcc/fortran/ChangeLog:

2017-03-05  Andre Vehreschild  <vehre@gcc.gnu.org>
            Alessandro Fanfarillo  <fanfarillo.gcc@gmail.com>

	* check.c (positive_check): Add new function checking constant for
	being greater then zero.
	(gfc_check_image_status): Add checking of image_status arguments.
	(gfc_check_failed_or_stopped_images): Same but for failed_- and
	stopped_images function.
	* dump-parse-tree.c (show_code_node): Added output of FAIL IMAGE.
	* gfortran.h (enum gfc_statement): Added FAIL_IMAGE_ST.
	(enum gfc_isym_id): Added new intrinsic symbols.
	(enum gfc_exec_op): Added EXEC_FAIL_IMAGE.
	* gfortran.texi: Added description for the new API functions. Updated
	coverage of gfortran of TS18508.
	* intrinsic.c (add_functions): Added symbols to resolve new intrinsic
	functions. 
	* intrinsic.h: Added prototypes.
	* iresolve.c (gfc_resolve_failed_images): Resolve the failed_images
	intrinsic.
	(gfc_resolve_image_status): Same for image_status.
	(gfc_resolve_stopped_images): Same for stopped_images.
	* libgfortran.h: Added prototypes.
	* match.c (gfc_match_if): Added matching of FAIL IMAGE statement.
	(gfc_match_fail_image): Match a FAIL IMAGE statement.
	* match.h: Added prototype.
	* parse.c (decode_statement): Added matching for FAIL IMAGE.
	(next_statement): Same.
	(gfc_ascii_statement): Same.
	* resolve.c: Same.
	* simplify.c (gfc_simplify_failed_or_stopped_images): For COARRAY=
	single a constant result can be returne.d
	(gfc_simplify_image_status): For COARRAY=single the result is constant.
	* st.c (gfc_free_statement): Added FAIL_IMAGE handling.
	* trans-decl.c (gfc_build_builtin_function_decls): Added decls of the
	new intrinsics.
	* trans-expr.c (gfc_conv_procedure_call): This is first time all
	arguments of a function are optional, which is now handled here
	correctly.
	* trans-intrinsic.c (conv_intrinsic_image_status): Translate
	image_status.
	(gfc_conv_intrinsic_function): Add support for image_status.
	(gfc_is_intrinsic_libcall): Add support for the remaining new
	intrinsics.
	* trans-stmt.c (gfc_trans_fail_image): Trans a fail image.
	* trans-stmt.h: Add the prototype for the above.
	* trans.c (trans_code): Dispatch for fail_image.
	* trans.h: Add the trees for the new intrinsics.

libgfortran/ChangeLog:

2017-03-05  Andre Vehreschild  <vehre@gcc.gnu.org>
            Alessandro Fanfarillo  <fanfarillo.gcc@gmail.com>

	* caf/libcaf.h: Added prototypes and stat codes for failed and stopped
	images.
	* caf/single.c (void _gfortran_caf_fail_image): Add the routine.
	(int _gfortran_caf_image_status): Same.
	(_gfortran_caf_failed_images): Same.
	(_gfortran_caf_stopped_images): Same.


gcc/testsuite/ChangeLog:

2017-03-05  Andre Vehreschild  <vehre@gcc.gnu.org>
            Alessandro Fanfarillo  <fanfarillo.gcc@gmail.com>

	* gfortran.dg/coarray/fail_image_1.f08: New test.
	* gfortran.dg/coarray/fail_image_2.f08: New test.
	* gfortran.dg/coarray/failed_images_1.f08: New test.
	* gfortran.dg/coarray/failed_images_2.f08: New test.
	* gfortran.dg/coarray/image_status_1.f08: New test.
	* gfortran.dg/coarray/image_status_2.f08: New test.
	* gfortran.dg/coarray/stopped_images_1.f08: New test.
	* gfortran.dg/coarray/stopped_images_2.f08: New test.
	* gfortran.dg/coarray_fail_st.f90: New test.
	* gfortran.dg/coarray_failed_images_1.f08: New test.
	* gfortran.dg/coarray_image_status_1.f08: New test.
	* gfortran.dg/coarray_stopped_images_1.f08: New test.

From-SVN: r245900

1 files changed, 77 insertions, 0 deletions

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index c22bfa9..45bc68e 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -295,6 +295,29 @@ nonnegative_check (const char *arg, gfc_expr *expr)
 }
 
 
+/* If expr is a constant, then check to ensure that it is greater than zero.  */
+
+static bool
+positive_check (int n, gfc_expr *expr)
+{
+  int i;
+
+  if (expr->expr_type == EXPR_CONSTANT)
+    {
+      gfc_extract_int (expr, &i);
+      if (i <= 0)
+	{
+	  gfc_error ("%qs argument of %qs intrinsic at %L must be positive",
+		     gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic,
+		     &expr->where);
+	  return false;
+	}
+    }
+
+  return true;
+}
+
+
 /* If expr2 is constant, then check that the value is less than
    (less than or equal to, if 'or_equal' is true) bit_size(expr1).  */
 
@@ -1138,6 +1161,60 @@ gfc_check_atomic_ref (gfc_expr *value, gfc_expr *atom, gfc_expr *stat)
 
 
 bool
+gfc_check_image_status (gfc_expr *image, gfc_expr *team)
+{
+  /* IMAGE has to be a positive, scalar integer.  */
+  if (!type_check (image, 0, BT_INTEGER) || !scalar_check (image, 0)
+      || !positive_check (0, image))
+    return false;
+
+  if (team)
+    {
+      gfc_error ("%qs argument of %qs intrinsic at %L not yet supported",
+		 gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
+		 &team->where);
+      return false;
+    }
+  return true;
+}
+
+
+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 (kind)
+    {
+      int k;
+
+      if (!type_check (kind, 1, BT_INTEGER) || !scalar_check (kind, 1)
+	  || !positive_check (1, kind))
+	return false;
+
+      /* Get the kind, reporting error on non-constant or overflow.  */
+      gfc_current_locus = kind->where;
+      if (gfc_extract_int (kind, &k, 1))
+	return false;
+      if (gfc_validate_kind (BT_INTEGER, k, true) == -1)
+	{
+	  gfc_error ("%qs argument of %qs intrinsic at %L shall specify a "
+		     "valid integer kind", gfc_current_intrinsic_arg[1]->name,
+		     gfc_current_intrinsic, &kind->where);
+	  return false;
+	}
+    }
+  return true;
+}
+
+
+bool
 gfc_check_atomic_cas (gfc_expr *atom, gfc_expr *old, gfc_expr *compare,
 		      gfc_expr *new_val,  gfc_expr *stat)
 {