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.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@245900 138bc75d-0d04-0410-961f-82ee72b054a4

22 files changed, 526 insertions, 13 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 8321cea619b..8640646127c 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,51 @@
+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.
+
 2017-03-03  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
 	PR fortran/79841
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index c22bfa965eb..45bc68ef7ad 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)
 {
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 36fc4cc0969..87a530458f9 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1818,6 +1818,10 @@ show_code_node (int level, gfc_code *c)
 
       break;
 
+    case EXEC_FAIL_IMAGE:
+      fputs ("FAIL IMAGE ", dumpfile);
+      break;
+
     case EXEC_SYNC_ALL:
       fputs ("SYNC ALL ", dumpfile);
       if (c->expr2 != NULL)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 814ce7847c8..293655078a4 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -263,7 +263,7 @@ enum gfc_statement
   ST_OMP_TASKLOOP_SIMD, ST_OMP_END_TASKLOOP_SIMD, ST_OMP_ORDERED_DEPEND,
   ST_PROCEDURE, ST_GENERIC, ST_CRITICAL, ST_END_CRITICAL,
   ST_GET_FCN_CHARACTERISTICS, ST_LOCK, ST_UNLOCK, ST_EVENT_POST,
-  ST_EVENT_WAIT,ST_NONE
+  ST_EVENT_WAIT,ST_FAIL_IMAGE,ST_NONE
 };
 
 /* Types of interfaces that we can have.  Assignment interfaces are
@@ -429,6 +429,7 @@ enum gfc_isym_id
   GFC_ISYM_EXP,
   GFC_ISYM_EXPONENT,
   GFC_ISYM_EXTENDS_TYPE_OF,
+  GFC_ISYM_FAILED_IMAGES,
   GFC_ISYM_FDATE,
   GFC_ISYM_FE_RUNTIME_ERROR,
   GFC_ISYM_FGET,
@@ -472,6 +473,7 @@ enum gfc_isym_id
   GFC_ISYM_IEOR,
   GFC_ISYM_IERRNO,
   GFC_ISYM_IMAGE_INDEX,
+  GFC_ISYM_IMAGE_STATUS,
   GFC_ISYM_INDEX,
   GFC_ISYM_INT,
   GFC_ISYM_INT2,
@@ -585,6 +587,7 @@ enum gfc_isym_id
   GFC_ISYM_SRAND,
   GFC_ISYM_SR_KIND,
   GFC_ISYM_STAT,
+  GFC_ISYM_STOPPED_IMAGES,
   GFC_ISYM_STORAGE_SIZE,
   GFC_ISYM_STRIDE,
   GFC_ISYM_SUM,
@@ -2457,7 +2460,7 @@ enum gfc_exec_op
   EXEC_OPEN, EXEC_CLOSE, EXEC_WAIT,
   EXEC_READ, EXEC_WRITE, EXEC_IOLENGTH, EXEC_TRANSFER, EXEC_DT_END,
   EXEC_BACKSPACE, EXEC_ENDFILE, EXEC_INQUIRE, EXEC_REWIND, EXEC_FLUSH,
-  EXEC_LOCK, EXEC_UNLOCK, EXEC_EVENT_POST, EXEC_EVENT_WAIT,
+  EXEC_LOCK, EXEC_UNLOCK, EXEC_EVENT_POST, EXEC_EVENT_WAIT, EXEC_FAIL_IMAGE,
   EXEC_OACC_KERNELS_LOOP, EXEC_OACC_PARALLEL_LOOP, EXEC_OACC_ROUTINE,
   EXEC_OACC_PARALLEL, EXEC_OACC_KERNELS, EXEC_OACC_DATA, EXEC_OACC_HOST_DATA,
   EXEC_OACC_LOOP, EXEC_OACC_UPDATE, EXEC_OACC_WAIT, EXEC_OACC_CACHE,
diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index ed9aa93a842..85afdda46ef 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -1125,7 +1125,7 @@ of @code{BIND(C) procedures.}
 @item GNU Fortran's implementation for variables with @code{ASYNCHRONOUS}
 attribute is compatible with TS 29113.
 
-@item Assumed types (@code{TYPE(*)}.
+@item Assumed types (@code{TYPE(*)}).
 
 @item Assumed-rank (@code{DIMENSION(..)}). However, the array descriptor
 of the TS is not yet supported.
@@ -1147,6 +1147,10 @@ do not support polymorphic types or types with allocatable, pointer or
 polymorphic components.
 
 @item Events (@code{EVENT POST}, @code{EVENT WAIT}, @code{EVENT_QUERY})
+
+@item Failed images (@code{FAIL IMAGE}, @code{IMAGE_STATUS},
+@code{FAILED_IMAGES}, @code{STOPPED_IMAGES})
+
 @end itemize
 
 
@@ -3873,6 +3877,7 @@ of such a type
 * caf_register_t::
 * caf_deregister_t::
 * caf_reference_t::
+* caf_team_t::
 @end menu
 
 @node caf_token_t
@@ -4035,6 +4040,11 @@ type conversion still needs to take place the type is transported here.
 At the moment @code{CAF_ARR_REF_VECTOR} is not implemented in the front end for
 descriptor-less arrays.  The library caf_single has untested support for it.
 
+@node caf_team_t
+@subsection @code{caf_team_t}
+
+Opaque pointer to represent a team-handle.  This type is a stand-in for the
+future implementation of teams.  It is about to change without further notice.
 
 @node Function ABI Documentation
 @section Function ABI Documentation
@@ -4044,6 +4054,9 @@ descriptor-less arrays.  The library caf_single has untested support for it.
 * _gfortran_caf_finish:: Finalization function
 * _gfortran_caf_this_image:: Querying the image number
 * _gfortran_caf_num_images:: Querying the maximal number of images
+* _gfortran_caf_image_status :: Query the status of an image
+* _gfortran_caf_failed_images :: Get an array of the indexes of the failed images
+* _gfortran_caf_stopped_images :: Get an array of the indexes of the stopped images
 * _gfortran_caf_register:: Registering coarrays
 * _gfortran_caf_deregister:: Deregistering coarrays
 * _gfortran_caf_is_present:: Query whether an allocatable or pointer component in a derived type coarray is allocated
@@ -4063,6 +4076,7 @@ descriptor-less arrays.  The library caf_single has untested support for it.
 * _gfortran_caf_sync_memory:: Wait for completion of segment-memory operations
 * _gfortran_caf_error_stop:: Error termination with exit code
 * _gfortran_caf_error_stop_str:: Error termination with string
+* _gfortran_caf_fail_image :: Mark the image failed and end its execution
 * _gfortran_caf_atomic_define:: Atomic variable assignment
 * _gfortran_caf_atomic_ref:: Atomic variable reference
 * _gfortran_caf_atomic_cas:: Atomic compare and swap
@@ -4182,6 +4196,90 @@ then the compiler passes @code{distance=0} and @code{failed=-1} to the function.
 @end table
 
 
+@node _gfortran_caf_image_status
+@subsection @code{_gfortran_caf_image_status} --- Query the status of an image
+@cindex Coarray, _gfortran_caf_image_status
+
+@table @asis
+@item @emph{Description}:
+Get the status of the image given by the id @var{image} of the team given by
+@var{team}.  Valid results are zero, for image is ok, @code{STAT_STOPPED_IMAGE}
+from the ISO_FORTRAN_ENV module to indicate that the image has been stopped and
+@code{STAT_FAILED_IMAGE} also from ISO_FORTRAN_ENV to indicate that the image
+has executed a @code{FAIL IMAGE} statement.
+
+@item @emph{Syntax}:
+@code{int _gfortran_caf_image_status (int image, caf_team_t * team)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{image} @tab the positive scalar id of the image in the current TEAM.
+@item @var{team} @tab optional; team on the which the inquiry is to be
+performed.
+@end multitable
+
+@item @emph{NOTES}
+This function follows TS18508.  Because team-functionality is not yet
+implemented a null-pointer is passed for the @var{team} argument at the moment.
+@end table
+
+
+@node _gfortran_caf_failed_images
+@subsection @code{_gfortran_caf_failed_images} --- Get an array of the indexes of the failed images
+@cindex Coarray, _gfortran_caf_failed_images
+
+@table @asis
+@item @emph{Description}:
+Get an array of image indexes in the current @var{team} that have failed.  The
+array is sorted ascendingly.  When @var{team} is not provided the current team
+is to be used.  When @var{kind} is provided then the resulting array is of that
+integer kind else it is of default integer kind.  The returns an unallocated
+size zero array when no images have failed.
+
+@item @emph{Syntax}:
+@code{int _gfortran_caf_failed_images (caf_team_t * team, int * kind)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{team} @tab optional; team on the which the inquiry is to be
+performed.
+@item @var{image} @tab optional; the kind of the resulting integer array.
+@end multitable
+
+@item @emph{NOTES}
+This function follows TS18508.  Because team-functionality is not yet
+implemented a null-pointer is passed for the @var{team} argument at the moment.
+@end table
+
+
+@node _gfortran_caf_stopped_images
+@subsection @code{_gfortran_caf_stopped_images} --- Get an array of the indexes of the stopped images
+@cindex Coarray, _gfortran_caf_stopped_images
+
+@table @asis
+@item @emph{Description}:
+Get an array of image indexes in the current @var{team} that have stopped.  The
+array is sorted ascendingly.  When @var{team} is not provided the current team
+is to be used.  When @var{kind} is provided then the resulting array is of that
+integer kind else it is of default integer kind.  The returns an unallocated
+size zero array when no images have failed.
+
+@item @emph{Syntax}:
+@code{int _gfortran_caf_stopped_images (caf_team_t * team, int * kind)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{team} @tab optional; team on the which the inquiry is to be
+performed.
+@item @var{image} @tab optional; the kind of the resulting integer array.
+@end multitable
+
+@item @emph{NOTES}
+This function follows TS18508.  Because team-functionality is not yet
+implemented a null-pointer is passed for the @var{team} argument at the moment.
+@end table
+
+
 @node _gfortran_caf_register
 @subsection @code{_gfortran_caf_register} --- Registering coarrays
 @cindex Coarray, _gfortran_caf_register
@@ -4993,6 +5091,24 @@ function should terminate the program with a nonzero-exit code.
 
 
 
+@node _gfortran_caf_fail_image
+@subsection @code{_gfortran_caf_fail_image} --- Mark the image failed and end its execution
+@cindex Coarray, _gfortran_caf_fail_image
+
+@table @asis
+@item @emph{Description}:
+Invoked for an @code{FAIL IMAGE} statement.  The function should terminate the
+current image.
+
+@item @emph{Syntax}:
+@code{void _gfortran_caf_fail_image ()}
+
+@item @emph{NOTES}
+This function follows TS18508.
+@end table
+
+
+
 @node _gfortran_caf_atomic_define
 @subsection @code{_gfortran_caf_atomic_define} --- Atomic variable assignment
 @cindex Coarray, _gfortran_caf_atomic_define
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 923572d888c..2f60fe8c877 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -1840,6 +1840,13 @@ add_functions (void)
 	     a, BT_UNKNOWN, 0, REQUIRED,
 	     mo, BT_UNKNOWN, 0, REQUIRED);
 
+  add_sym_2 ("failed_images", GFC_ISYM_FAILED_IMAGES, CLASS_TRANSFORMATIONAL,
+	     ACTUAL_NO, BT_INTEGER, dd, GFC_STD_F2008_TS,
+	     gfc_check_failed_or_stopped_images,
+	     gfc_simplify_failed_or_stopped_images,
+	     gfc_resolve_failed_images, "team", BT_VOID, di, OPTIONAL,
+	     "kind", BT_INTEGER, di, OPTIONAL);
+
   add_sym_0 ("fdate",  GFC_ISYM_FDATE, CLASS_IMPURE, ACTUAL_NO, BT_CHARACTER,
 	     dc, GFC_STD_GNU, NULL, NULL, gfc_resolve_fdate);
 
@@ -2081,6 +2088,11 @@ add_functions (void)
 	     gfc_check_image_index, gfc_simplify_image_index, gfc_resolve_image_index,
 	     ca, BT_REAL, dr, REQUIRED, sub, BT_INTEGER, ii, REQUIRED);
 
+  add_sym_2 ("image_status", GFC_ISYM_IMAGE_STATUS, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_INTEGER, di, GFC_STD_F2008_TS, gfc_check_image_status,
+	     gfc_simplify_image_status, gfc_resolve_image_status, "image",
+	     BT_INTEGER, di, REQUIRED, "team", BT_VOID, di, OPTIONAL);
+
   /* The resolution function for INDEX is called gfc_resolve_index_func
      because the name gfc_resolve_index is already used in resolve.c.  */
   add_sym_4 ("index", GFC_ISYM_INDEX, CLASS_ELEMENTAL, ACTUAL_YES,
@@ -2989,6 +3001,13 @@ add_functions (void)
 
   make_generic ("stat", GFC_ISYM_STAT, GFC_STD_GNU);
 
+  add_sym_2 ("stopped_images", GFC_ISYM_STOPPED_IMAGES, CLASS_TRANSFORMATIONAL,
+	     ACTUAL_NO, BT_INTEGER, dd, GFC_STD_F2008_TS,
+	     gfc_check_failed_or_stopped_images,
+	     gfc_simplify_failed_or_stopped_images,
+	     gfc_resolve_stopped_images, "team", BT_VOID, di, OPTIONAL,
+	     "kind", BT_INTEGER, di, OPTIONAL);
+
   add_sym_2 ("storage_size", GFC_ISYM_STORAGE_SIZE, CLASS_INQUIRY, ACTUAL_NO,
 	     BT_INTEGER, di, GFC_STD_F2008,
 	     gfc_check_storage_size, gfc_simplify_storage_size,
diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h
index 756c5c6dee9..e8280f6f2ac 100644
--- a/gcc/fortran/intrinsic.h
+++ b/gcc/fortran/intrinsic.h
@@ -71,6 +71,7 @@ bool gfc_check_dshift (gfc_expr *, gfc_expr *, gfc_expr *);
 bool gfc_check_eoshift (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 bool gfc_check_dtime_etime (gfc_expr *);
 bool gfc_check_event_query (gfc_expr *, gfc_expr *, gfc_expr *);
+bool gfc_check_failed_or_stopped_images (gfc_expr *, gfc_expr *);
 bool gfc_check_fgetputc (gfc_expr *, gfc_expr *);
 bool gfc_check_fgetput (gfc_expr *);
 bool gfc_check_float (gfc_expr *);
@@ -92,6 +93,7 @@ bool gfc_check_ibits (gfc_expr *, gfc_expr *, gfc_expr *);
 bool gfc_check_ichar_iachar (gfc_expr *, gfc_expr *);
 bool gfc_check_idnint (gfc_expr *);
 bool gfc_check_ieor (gfc_expr *, gfc_expr *);
+bool gfc_check_image_status (gfc_expr *, gfc_expr *);
 bool gfc_check_index (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 bool gfc_check_int (gfc_expr *, gfc_expr *);
 bool gfc_check_intconv (gfc_expr *);
@@ -292,6 +294,7 @@ gfc_expr *gfc_simplify_erfc_scaled (gfc_expr *);
 gfc_expr *gfc_simplify_exp (gfc_expr *);
 gfc_expr *gfc_simplify_exponent (gfc_expr *);
 gfc_expr *gfc_simplify_extends_type_of (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_failed_or_stopped_images (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_float (gfc_expr *);
 gfc_expr *gfc_simplify_floor (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_fraction (gfc_expr *);
@@ -308,6 +311,7 @@ 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_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 *);
 gfc_expr *gfc_simplify_int2 (gfc_expr *);
@@ -473,6 +477,7 @@ void gfc_resolve_event_query (gfc_code *);
 void gfc_resolve_exp (gfc_expr *, gfc_expr *);
 void gfc_resolve_exponent (gfc_expr *, gfc_expr *);
 void gfc_resolve_extends_type_of (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_failed_images (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_fdate (gfc_expr *);
 void gfc_resolve_floor (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_fnum (gfc_expr *, gfc_expr *);
@@ -496,6 +501,7 @@ 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_status (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_index_func (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
 			     gfc_expr *);
 void gfc_resolve_ierrno (gfc_expr *);
@@ -571,12 +577,13 @@ void gfc_resolve_signal (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_sin (gfc_expr *, gfc_expr *);
 void gfc_resolve_sinh (gfc_expr *, gfc_expr *);
 void gfc_resolve_size (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
-void gfc_resolve_stride (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_spacing (gfc_expr *, gfc_expr *);
 void gfc_resolve_spread (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_sqrt (gfc_expr *, gfc_expr *);
 void gfc_resolve_stat (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_stopped_images (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_storage_size (gfc_expr *f, gfc_expr *a, gfc_expr *kind);
+void gfc_resolve_stride (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_srand (gfc_code *);
 void gfc_resolve_sum (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_symlnk (gfc_expr *, gfc_expr *, gfc_expr *);
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index f5a44623946..b784ac339e9 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -2830,6 +2830,38 @@ gfc_resolve_atan2d (gfc_expr *f, gfc_expr *x, gfc_expr *y ATTRIBUTE_UNUSED)
 }
 
 
+/* Resolve failed_images (team, kind).  */
+
+void
+gfc_resolve_failed_images (gfc_expr *f, gfc_expr *team ATTRIBUTE_UNUSED,
+			   gfc_expr *kind)
+{
+  static char failed_images[] = "_gfortran_caf_failed_images";
+  f->rank = 1;
+  f->ts.type = BT_INTEGER;
+  if (kind == NULL)
+    f->ts.kind = gfc_default_integer_kind;
+  else
+    gfc_extract_int (kind, &f->ts.kind);
+  f->value.function.name = failed_images;
+}
+
+
+/* Resolve image_status (image, team).  */
+
+void
+gfc_resolve_image_status (gfc_expr *f, gfc_expr *image ATTRIBUTE_UNUSED,
+			  gfc_expr *team ATTRIBUTE_UNUSED)
+{
+  static char image_status[] = "_gfortran_caf_image_status";
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_default_integer_kind;
+  f->value.function.name = image_status;
+}
+
+
+/* Resolve image_index (...).  */
+
 void
 gfc_resolve_image_index (gfc_expr *f, gfc_expr *array ATTRIBUTE_UNUSED,
 			 gfc_expr *sub ATTRIBUTE_UNUSED)
@@ -2841,6 +2873,23 @@ gfc_resolve_image_index (gfc_expr *f, gfc_expr *array ATTRIBUTE_UNUSED,
 }
 
 
+/* Resolve stopped_images (team, kind).  */
+
+void
+gfc_resolve_stopped_images (gfc_expr *f, gfc_expr *team ATTRIBUTE_UNUSED,
+			    gfc_expr *kind)
+{
+  static char stopped_images[] = "_gfortran_caf_stopped_images";
+  f->rank = 1;
+  f->ts.type = BT_INTEGER;
+  if (kind == NULL)
+    f->ts.kind = gfc_default_integer_kind;
+  else
+    gfc_extract_int (kind, &f->ts.kind);
+  f->value.function.name = stopped_images;
+}
+
+
 void
 gfc_resolve_this_image (gfc_expr *f, gfc_expr *array, gfc_expr *dim,
 			gfc_expr *distance ATTRIBUTE_UNUSED)
diff --git a/gcc/fortran/libgfortran.h b/gcc/fortran/libgfortran.h
index 9f657bd525e..c5ff9924761 100644
--- a/gcc/fortran/libgfortran.h
+++ b/gcc/fortran/libgfortran.h
@@ -117,14 +117,14 @@ typedef enum
 }
 libgfortran_error_codes;
 
-/* Must kept in sync with libgfortrancaf.h.  */
+/* Must kept in sync with libgfortran/caf/libcaf.h.  */
 typedef enum
 {
   GFC_STAT_UNLOCKED = 0,
   GFC_STAT_LOCKED,
   GFC_STAT_LOCKED_OTHER_IMAGE,
   GFC_STAT_STOPPED_IMAGE = 6000, /* See LIBERROR_INQUIRE_INTERNAL_UNIT above. */
-  GFC_STAT_FAILED_IMAGE
+  GFC_STAT_FAILED_IMAGE  = 6001
 }
 libgfortran_stat_codes;
 
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index fc37f227e8a..a47585c5516 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -1601,6 +1601,7 @@ gfc_match_if (gfc_statement *if_type)
   match ("event post", gfc_match_event_post, ST_EVENT_POST)
   match ("event wait", gfc_match_event_wait, ST_EVENT_WAIT)
   match ("exit", gfc_match_exit, ST_EXIT)
+  match ("fail image", gfc_match_fail_image, ST_FAIL_IMAGE)
   match ("flush", gfc_match_flush, ST_FLUSH)
   match ("forall", match_simple_forall, ST_FORALL)
   match ("go to", gfc_match_goto, ST_GOTO)
@@ -3265,6 +3266,28 @@ gfc_match_event_wait (void)
 }
 
 
+/* Match a FAIL IMAGE statement.  */
+
+match
+gfc_match_fail_image (void)
+{
+  if (!gfc_notify_std (GFC_STD_F2008_TS, "FAIL IMAGE statement at %C"))
+    return MATCH_ERROR;
+
+  if (gfc_match_char ('(') == MATCH_YES)
+    goto syntax;
+
+  new_st.op = EXEC_FAIL_IMAGE;
+
+  return MATCH_YES;
+
+syntax:
+  gfc_syntax_error (ST_FAIL_IMAGE);
+
+  return MATCH_ERROR;
+}
+
+
 /* Match LOCK/UNLOCK statement. Syntax:
      LOCK ( lock-variable [ , lock-stat-list ] )
      UNLOCK ( lock-variable [ , sync-stat-list ] )
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index c8e8fc1cc4f..64f2038f032 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -73,6 +73,7 @@ match gfc_match_elseif (void);
 match gfc_match_event_post (void);
 match gfc_match_event_wait (void);
 match gfc_match_critical (void);
+match gfc_match_fail_image (void);
 match gfc_match_block (void);
 match gfc_match_associate (void);
 match gfc_match_do (void);
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 3c568ee8c83..28fa218b2fc 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -488,6 +488,7 @@ decode_statement (void)
       break;
 
     case 'f':
+      match ("fail image", gfc_match_fail_image, ST_FAIL_IMAGE);
       match ("final", gfc_match_final_decl, ST_FINAL);
       match ("flush", gfc_match_flush, ST_FLUSH);
       match ("format", gfc_match_format, ST_FORMAT);
@@ -1499,7 +1500,7 @@ next_statement (void)
   case ST_OMP_TARGET_EXIT_DATA: case ST_OMP_ORDERED_DEPEND: \
   case ST_ERROR_STOP: case ST_SYNC_ALL: \
   case ST_SYNC_IMAGES: case ST_SYNC_MEMORY: case ST_LOCK: case ST_UNLOCK: \
-  case ST_EVENT_POST: case ST_EVENT_WAIT: \
+  case ST_EVENT_POST: case ST_EVENT_WAIT: case ST_FAIL_IMAGE: \
   case ST_OACC_UPDATE: case ST_OACC_WAIT: case ST_OACC_CACHE: \
   case ST_OACC_ENTER_DATA: case ST_OACC_EXIT_DATA
 
@@ -1827,6 +1828,9 @@ gfc_ascii_statement (gfc_statement st)
     case ST_EVENT_WAIT:
       p = "EVENT WAIT";
       break;
+    case ST_FAIL_IMAGE:
+      p = "FAIL IMAGE";
+      break;
     case ST_END_ASSOCIATE:
       p = "END ASSOCIATE";
       break;
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 37ffde820e0..1fbc9f6ef93 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -10883,6 +10883,9 @@ start:
 	  resolve_lock_unlock_event (code);
 	  break;
 
+	case EXEC_FAIL_IMAGE:
+	  break;
+
 	case EXEC_ENTRY:
 	  /* Keep track of which entry we are up to.  */
 	  current_entry_id = code->ext.entry->id;
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 8ffe75a4a46..169aef1d892 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -2466,6 +2466,37 @@ gfc_simplify_exponent (gfc_expr *x)
 
 
 gfc_expr *
+gfc_simplify_failed_or_stopped_images (gfc_expr *team ATTRIBUTE_UNUSED,
+				       gfc_expr *kind)
+{
+  if (flag_coarray == GFC_FCOARRAY_NONE)
+    {
+      gfc_current_locus = *gfc_current_intrinsic_where;
+      gfc_fatal_error ("Coarrays disabled at %C, use %<-fcoarray=%> to enable");
+      return &gfc_bad_expr;
+    }
+
+  if (flag_coarray == GFC_FCOARRAY_SINGLE)
+    {
+      gfc_expr *result;
+      int actual_kind;
+      if (kind)
+	gfc_extract_int (kind, &actual_kind);
+      else
+	actual_kind = gfc_default_integer_kind;
+
+      result = gfc_get_array_expr (BT_INTEGER, actual_kind, &gfc_current_locus);
+      result->rank = 1;
+      return result;
+    }
+
+  /* For fcoarray = lib no simplification is possible, because it is not known
+     what images failed or are stopped at compile time.  */
+  return NULL;
+}
+
+
+gfc_expr *
 gfc_simplify_float (gfc_expr *a)
 {
   gfc_expr *result;
@@ -6763,6 +6794,36 @@ gfc_simplify_image_index (gfc_expr *coarray, gfc_expr *sub)
   return result;
 }
 
+gfc_expr *
+gfc_simplify_image_status (gfc_expr *image, gfc_expr *team ATTRIBUTE_UNUSED)
+{
+  if (flag_coarray == GFC_FCOARRAY_NONE)
+    {
+      gfc_current_locus = *gfc_current_intrinsic_where;
+      gfc_fatal_error ("Coarrays disabled at %C, use %<-fcoarray=%> to enable");
+      return &gfc_bad_expr;
+    }
+
+  /* Simplification is possible for fcoarray = single only.  For all other modes
+     the result depends on runtime conditions.  */
+  if (flag_coarray != GFC_FCOARRAY_SINGLE)
+    return NULL;
+
+  if (gfc_is_constant_expr (image))
+    {
+      gfc_expr *result;
+      result = gfc_get_constant_expr (BT_INTEGER, gfc_default_integer_kind,
+				      &image->where);
+      if (mpz_get_si (image->value.integer) == 1)
+	mpz_set_si (result->value.integer, 0);
+      else
+	mpz_set_si (result->value.integer, GFC_STAT_STOPPED_IMAGE);
+      return result;
+    }
+  else
+    return NULL;
+}
+
 
 gfc_expr *
 gfc_simplify_this_image (gfc_expr *coarray, gfc_expr *dim,
diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c
index acef6cffc02..bffe50df7b8 100644
--- a/gcc/fortran/st.c
+++ b/gcc/fortran/st.c
@@ -120,6 +120,7 @@ gfc_free_statement (gfc_code *p)
     case EXEC_UNLOCK:
     case EXEC_EVENT_POST:
     case EXEC_EVENT_WAIT:
+    case EXEC_FAIL_IMAGE:
       break;
 
     case EXEC_BLOCK:
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 41b36a59495..449ca9a84da 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -153,6 +153,10 @@ tree gfor_fndecl_caf_unlock;
 tree gfor_fndecl_caf_event_post;
 tree gfor_fndecl_caf_event_wait;
 tree gfor_fndecl_caf_event_query;
+tree gfor_fndecl_caf_fail_image;
+tree gfor_fndecl_caf_failed_images;
+tree gfor_fndecl_caf_image_status;
+tree gfor_fndecl_caf_stopped_images;
 tree gfor_fndecl_co_broadcast;
 tree gfor_fndecl_co_max;
 tree gfor_fndecl_co_min;
@@ -3732,6 +3736,28 @@ gfc_build_builtin_function_decls (void)
 	void_type_node, 5, pvoid_type_node, size_type_node, integer_type_node,
 	pint_type, pint_type);
 
+      gfor_fndecl_caf_fail_image = gfc_build_library_function_decl (
+	get_identifier (PREFIX("caf_fail_image")), void_type_node, 0);
+      /* CAF's FAIL doesn't return.  */
+      TREE_THIS_VOLATILE (gfor_fndecl_caf_fail_image) = 1;
+
+      gfor_fndecl_caf_failed_images
+	= gfc_build_library_function_decl_with_spec (
+	    get_identifier (PREFIX("caf_failed_images")), "WRR",
+	    void_type_node, 3, pvoid_type_node, ppvoid_type_node,
+	    integer_type_node);
+
+      gfor_fndecl_caf_image_status
+	= gfc_build_library_function_decl_with_spec (
+	    get_identifier (PREFIX("caf_image_status")), "RR",
+	    integer_type_node, 2, integer_type_node, ppvoid_type_node);
+
+      gfor_fndecl_caf_stopped_images
+	= gfc_build_library_function_decl_with_spec (
+	    get_identifier (PREFIX("caf_stopped_images")), "WRR",
+	    void_type_node, 3, pvoid_type_node, ppvoid_type_node,
+	    integer_type_node);
+
       gfor_fndecl_co_broadcast = gfc_build_library_function_decl_with_spec (
 	get_identifier (PREFIX("caf_co_broadcast")), "W.WW",
 	void_type_node, 5, pvoid_type_node, integer_type_node,
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 9c4715b44be..7bced25df49 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -6228,13 +6228,15 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
       gfc_add_block_to_block (&se->pre, &post);
 
       /* Transformational functions of derived types with allocatable
-         components must have the result allocatable components copied.  */
+	 components must have the result allocatable components copied when the
+	 argument is actually given.  */
       arg = expr->value.function.actual;
       if (result && arg && expr->rank
-	    && expr->value.function.isym
-	    && expr->value.function.isym->transformational
-	    && arg->expr->ts.type == BT_DERIVED
-	    && arg->expr->ts.u.derived->attr.alloc_comp)
+	  && expr->value.function.isym
+	  && expr->value.function.isym->transformational
+	  && arg->expr
+	  && arg->expr->ts.type == BT_DERIVED
+	  && arg->expr->ts.u.derived->attr.alloc_comp)
 	{
 	  tree tmp2;
 	  /* Copy the allocatable components.  We have to use a
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 14781ac4814..b7524bceb6b 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -2388,6 +2388,42 @@ trans_this_image (gfc_se * se, gfc_expr *expr)
 }
 
 
+/* Convert a call to image_status.  */
+
+static void
+conv_intrinsic_image_status (gfc_se *se, gfc_expr *expr)
+{
+  unsigned int num_args;
+  tree *args, tmp;
+
+  num_args = gfc_intrinsic_argument_list_length (expr);
+  args = XALLOCAVEC (tree, num_args);
+  gfc_conv_intrinsic_function_args (se, expr, args, num_args);
+  /* In args[0] the number of the image the status is desired for has to be
+     given.  */
+
+  if (flag_coarray == GFC_FCOARRAY_SINGLE)
+    {
+      tree arg;
+      arg = gfc_evaluate_now (args[0], &se->pre);
+      tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
+			     fold_convert (integer_type_node, arg),
+			     integer_one_node);
+      tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node,
+			     tmp, integer_zero_node,
+			     build_int_cst (integer_type_node,
+					    GFC_STAT_STOPPED_IMAGE));
+    }
+  else if (flag_coarray == GFC_FCOARRAY_LIB)
+    tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_image_status, 2,
+			       args[0], build_int_cst (integer_type_node, -1));
+  else
+    gcc_unreachable ();
+
+  se->expr = tmp;
+}
+
+
 static void
 trans_image_index (gfc_se * se, gfc_expr *expr)
 {
@@ -9108,6 +9144,10 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
       trans_image_index (se, expr);
       break;
 
+    case GFC_ISYM_IMAGE_STATUS:
+      conv_intrinsic_image_status (se, expr);
+      break;
+
     case GFC_ISYM_NUM_IMAGES:
       trans_num_images (se, expr);
       break;
@@ -9458,10 +9498,12 @@ gfc_is_intrinsic_libcall (gfc_expr * expr)
       /* Ignore absent optional parameters.  */
       return 1;
 
-    case GFC_ISYM_RESHAPE:
     case GFC_ISYM_CSHIFT:
     case GFC_ISYM_EOSHIFT:
+    case GFC_ISYM_FAILED_IMAGES:
+    case GFC_ISYM_STOPPED_IMAGES:
     case GFC_ISYM_PACK:
+    case GFC_ISYM_RESHAPE:
     case GFC_ISYM_UNPACK:
       /* Pass absent optional parameters.  */
       return 2;
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 773ca704f38..98687c80637 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -674,6 +674,24 @@ gfc_trans_stop (gfc_code *code, bool error_stop)
   return gfc_finish_block (&se.pre);
 }
 
+/* Translate the FAIL IMAGE statement.  */
+
+tree
+gfc_trans_fail_image (gfc_code *code ATTRIBUTE_UNUSED)
+{
+  if (flag_coarray == GFC_FCOARRAY_LIB)
+    return build_call_expr_loc (input_location,
+				gfor_fndecl_caf_fail_image, 1,
+				build_int_cst (pchar_type_node, 0));
+  else
+    {
+      const char *name = gfc_get_string (PREFIX ("exit_i%d"), 4);
+      gfc_symbol *exsym = gfc_get_intrinsic_sub_symbol (name);
+      tree tmp = gfc_get_symbol_decl (exsym);
+      return build_call_expr_loc (input_location, tmp, 1, integer_zero_node);
+    }
+}
+
 
 tree
 gfc_trans_lock_unlock (gfc_code *code, gfc_exec_op op)
diff --git a/gcc/fortran/trans-stmt.h b/gcc/fortran/trans-stmt.h
index cc367bf8f8a..0a39e26c218 100644
--- a/gcc/fortran/trans-stmt.h
+++ b/gcc/fortran/trans-stmt.h
@@ -56,6 +56,7 @@ tree gfc_trans_select_type (gfc_code *);
 tree gfc_trans_sync (gfc_code *, gfc_exec_op);
 tree gfc_trans_lock_unlock (gfc_code *, gfc_exec_op);
 tree gfc_trans_event_post_wait (gfc_code *, gfc_exec_op);
+tree gfc_trans_fail_image (gfc_code *);
 tree gfc_trans_forall (gfc_code *);
 tree gfc_trans_where (gfc_code *);
 tree gfc_trans_allocate (gfc_code *);
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index 82ed19ac283..e25ccaa258a 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -1953,6 +1953,10 @@ trans_code (gfc_code * code, tree cond)
 	  res = gfc_trans_event_post_wait (code, code->op);
 	  break;
 
+	case EXEC_FAIL_IMAGE:
+	  res = gfc_trans_fail_image (code);
+	  break;
+
 	case EXEC_FORALL:
 	  res = gfc_trans_forall (code);
 	  break;
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index c72fd356c36..d02f3470eeb 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -833,6 +833,10 @@ extern GTY(()) tree gfor_fndecl_caf_unlock;
 extern GTY(()) tree gfor_fndecl_caf_event_post;
 extern GTY(()) tree gfor_fndecl_caf_event_wait;
 extern GTY(()) tree gfor_fndecl_caf_event_query;
+extern GTY(()) tree gfor_fndecl_caf_fail_image;
+extern GTY(()) tree gfor_fndecl_caf_failed_images;
+extern GTY(()) tree gfor_fndecl_caf_image_status;
+extern GTY(()) tree gfor_fndecl_caf_stopped_images;
 extern GTY(()) tree gfor_fndecl_co_broadcast;
 extern GTY(()) tree gfor_fndecl_co_max;
 extern GTY(()) tree gfor_fndecl_co_min;