[Fortran, Patch] First patch for coarray FAILED IMAGES (TS 18508)

[Fortran, Patch] First patch for coarray FAILED IMAGES (TS 18508)

[Alessandro Fanfarillo]

[-- Attachment #1: Type: text/plain, Size: 425 bytes --]

Dear all,

please find in attachment the first patch (of n) for the FAILED IMAGES
capability defined in the coarray TS 18508.
The patch adds support for three new intrinsic functions defined in
the TS for simulating a failure (fail image), checking an image status
(image_status) and getting the list of failed images (failed_images).
The patch has been built and regtested on x86_64-pc-linux-gnu.

Ok for trunk?

Alessandro

[-- Attachment #2: first_complete_patch.diff --]
[-- Type: text/plain, Size: 19497 bytes --]

commit b3bca5b09f4cbcf18f2409dae2485a16a7c06498
Author: Alessandro Fanfarillo <fanfarillo@ing.uniroma2.it>
Date:   Mon Jun 6 14:27:37 2016 -0600

    First patch Failed Images CAF TS-18508

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index d26e45e..71931cb 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -1210,6 +1210,62 @@ gfc_check_event_query (gfc_expr *event, gfc_expr *count, gfc_expr *stat)
   return true;
 }
 
+bool
+gfc_check_image_status (gfc_expr *image, gfc_expr *team)
+{
+  if (!type_check (image, 1, BT_INTEGER))
+    return false;
+
+  if(team)
+    {
+      gfc_error ("TEAM argument of the IMAGE_STATUS intrinsic function at %L "
+		 "not yet supported",
+		 &team->where);
+      return false;
+    }
+
+  int i = gfc_validate_kind (BT_INTEGER, image->ts.kind, false);
+  int j = gfc_validate_kind (BT_INTEGER, gfc_default_integer_kind, false);
+
+  if (gfc_integer_kinds[i].range < gfc_integer_kinds[j].range)
+    {
+      gfc_error ("IMAGE argument of the IMAGE_STATUS intrinsic function at %L "
+		 "shall have at least the range of the default integer",
+		 &image->where);
+      return false;
+    }
+
+  return true;
+}
+
+bool
+gfc_check_failed_images (gfc_expr *team, gfc_expr *kind)
+{
+  if (team)
+    {
+      gfc_error ("TEAM argument of the FAILED_IMAGES intrinsic function at %L "
+		 "not yet supported",
+		 &team->where);
+      return false;
+    }
+
+  if (kind)
+    {
+      int i = gfc_validate_kind (BT_INTEGER, kind->ts.kind, false);
+      int j = gfc_validate_kind (BT_INTEGER, gfc_default_integer_kind, false);
+
+      if (gfc_integer_kinds[i].range < gfc_integer_kinds[j].range)
+	{
+	  gfc_error ("KIND argument of the FAILED_IMAGES intrinsic function at %L "
+		     "shall have at least the range of the default integer",
+		     &kind->where);
+	  return false;
+	}
+    }
+
+  return true;
+}
+
 
 bool
 gfc_check_atomic_fetch_op (gfc_expr *atom, gfc_expr *value, gfc_expr *old,
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index f507434..41ed664 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1628,6 +1628,9 @@ show_code_node (int level, gfc_code *c)
 
       break;
 
+    case EXEC_FAIL_IMAGE:
+      fputs ("FAIL IMAGE ", dumpfile);
+
     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 0bb71cb..6d87632 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -253,7 +253,7 @@ enum gfc_statement
   ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD,
   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
@@ -411,6 +411,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,
@@ -454,6 +455,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,
@@ -2382,7 +2384,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/intrinsic.c b/gcc/fortran/intrinsic.c
index 1d7503d..8dfb568 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -1823,6 +1823,10 @@ 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_images, NULL,
+	     gfc_resolve_failed_images, "team", BT_INTEGER, 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);
 
@@ -2023,7 +2027,11 @@ add_functions (void)
   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_2 ("image_status", GFC_ISYM_IMAGE_STATUS, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER,
+	     di, GFC_STD_F2008_TS, gfc_check_image_status, NULL,
+	     gfc_resolve_image_status, "image", BT_INTEGER, di, REQUIRED, "team", BT_INTEGER, 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,
@@ -3170,7 +3178,7 @@ add_subroutines (void)
 	      "event", BT_INTEGER, di, REQUIRED, INTENT_IN,
 	      c, BT_INTEGER, di, OPTIONAL, INTENT_IN,
 	      stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
-
+
   /* More G77 compatibility garbage.  */
   add_sym_2s ("ctime", GFC_ISYM_CTIME, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
 	      gfc_check_ctime_sub, NULL, gfc_resolve_ctime_sub,
diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h
index f228976..bb49b7d 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_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 *);
@@ -467,6 +469,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 *);
@@ -490,6 +493,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 *);
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index ecea1c3..ce59c66 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -2577,6 +2577,26 @@ gfc_resolve_tanh (gfc_expr *f, gfc_expr *x)
     = gfc_get_string ("__tanh_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
 }
 
+void
+gfc_resolve_failed_images (gfc_expr *f, gfc_expr *team ATTRIBUTE_UNUSED,
+			   gfc_expr *kind ATTRIBUTE_UNUSED)
+{
+  static char failed_images[] = "_gfortran_caf_failed_images";
+  f->rank = 1;
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_default_integer_kind;
+  f->value.function.name = failed_images;
+}
+
+void
+gfc_resolve_image_status (gfc_expr *f, gfc_expr *image, gfc_expr *team ATTRIBUTE_UNUSED)
+{
+  static char image_status[] = "image_status";
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_default_integer_kind;
+  f->ts = image->ts;
+  f->value.function.name = image_status;
+}
 
 void
 gfc_resolve_image_index (gfc_expr *f, gfc_expr *array ATTRIBUTE_UNUSED,
diff --git a/gcc/fortran/libgfortran.h b/gcc/fortran/libgfortran.h
index e913250..f00ed83 100644
--- a/gcc/fortran/libgfortran.h
+++ b/gcc/fortran/libgfortran.h
@@ -123,7 +123,7 @@ typedef enum
   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 f3a4a43..9f519ff 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -1594,6 +1594,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)
@@ -3073,6 +3074,41 @@ gfc_match_event_wait (void)
   return event_statement (ST_EVENT_WAIT);
 }
 
+/* Match a FAIl IMAGE statement */
+
+static match
+fail_image_statement (gfc_statement st)
+{ 
+  if (flag_coarray == GFC_FCOARRAY_NONE)
+    {
+      gfc_fatal_error ("Coarrays disabled at %C, use %<-fcoarray=%> to enable");
+      return MATCH_ERROR;
+    }
+
+  if (gfc_match_char ('(') == MATCH_YES)
+    goto syntax;
+
+  if(st == ST_FAIL_IMAGE)
+    new_st.op = EXEC_FAIL_IMAGE;
+  else
+    gcc_unreachable();
+
+  return MATCH_YES;
+
+ syntax:
+  gfc_syntax_error (st);
+
+  return MATCH_ERROR;
+}
+
+match
+gfc_match_fail_image (void)
+{
+  /* if (!gfc_notify_std (GFC_STD_F2008_TS, "FAIL IMAGE statement at %C")) */
+  /*   return MATCH_ERROR; */
+
+  return fail_image_statement (ST_FAIL_IMAGE);
+}
 
 /* Match LOCK/UNLOCK statement. Syntax:
      LOCK ( lock-variable [ , lock-stat-list ] )
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index 348ca70..4e4b833 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -72,6 +72,7 @@ match gfc_match_else (void);
 match gfc_match_elseif (void);
 match gfc_match_event_post (void);
 match gfc_match_event_wait (void);
+match gfc_match_fail_image (void);
 match gfc_match_critical (void);
 match gfc_match_block (void);
 match gfc_match_associate (void);
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 1081b2e..3659d8a 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -483,6 +483,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);
@@ -1354,7 +1355,7 @@ next_statement (void)
   case ST_OMP_CANCEL: case ST_OMP_CANCELLATION_POINT: \
   case ST_OMP_TARGET_UPDATE: 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
 
@@ -1680,6 +1681,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 77f8c10..f56bdf1 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -8749,6 +8749,11 @@ find_reachable_labels (gfc_code *block)
     }
 }
 
+static void
+resolve_fail_image (gfc_code *code ATTRIBUTE_UNUSED)
+{
+  return;
+}
 
 static void
 resolve_lock_unlock_event (gfc_code *code)
@@ -10479,6 +10484,10 @@ start:
 	  resolve_lock_unlock_event (code);
 	  break;
 
+	case EXEC_FAIL_IMAGE:
+	  resolve_fail_image (code);
+	  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/st.c b/gcc/fortran/st.c
index 7395497..b3a6721 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 2f5e434..7c52744 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -151,6 +151,9 @@ 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_co_broadcast;
 tree gfor_fndecl_co_max;
 tree gfor_fndecl_co_min;
@@ -3628,6 +3631,18 @@ 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_with_spec (
+	get_identifier (PREFIX("caf_fail_image")), "R",
+	void_type_node, 1, pvoid_type_node);
+
+      gfor_fndecl_caf_failed_images = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("caf_failed_images")), "WRR",
+	pvoid_type_node, 3, pvoid_type_node, integer_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, 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 8f84712..70f9577 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -6132,10 +6132,11 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
          components must have the result allocatable components copied.  */
       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 1aaf4e2..b2f5596 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -1647,6 +1647,24 @@ trans_this_image (gfc_se * se, gfc_expr *expr)
 					       m, lbound));
 }
 
+static void
+gfc_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);
+
+  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));
+      se->expr = tmp;
+    }
+}
 
 static void
 trans_image_index (gfc_se * se, gfc_expr *expr)
@@ -8303,6 +8321,10 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
       trans_image_index (se, expr);
       break;
 
+    case GFC_ISYM_IMAGE_STATUS:
+      gfc_conv_intrinsic_image_status (se, expr);
+      break;
+
     case GFC_ISYM_NUM_IMAGES:
       trans_num_images (se, expr);
       break;
@@ -8653,10 +8675,11 @@ 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_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 7d3cf8c..ce0eae7 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -674,6 +674,31 @@ gfc_trans_stop (gfc_code *code, bool error_stop)
   return gfc_finish_block (&se.pre);
 }
 
+/* Translate the FAIL IMAGE statement.  We have to translate this statement
+   to a runtime library call.  */
+
+tree
+gfc_trans_fail_image (gfc_code *code ATTRIBUTE_UNUSED)
+{
+  tree gfc_int4_type_node = gfc_get_int_type (4);
+  gfc_se se;
+  tree tmp;
+
+  /* Start a new block for this statement.  */
+  gfc_init_se (&se, NULL);
+  gfc_start_block (&se.pre);
+
+  tmp = build_int_cst (gfc_int4_type_node, 0);
+  tmp = build_call_expr_loc (input_location,
+			     gfor_fndecl_caf_fail_image, 1,
+			     build_int_cst (pchar_type_node, 0));
+
+  gfc_add_expr_to_block (&se.pre, tmp);
+
+  gfc_add_block_to_block (&se.pre, &se.post);
+
+  return gfc_finish_block (&se.pre);
+}
 
 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 f9c8e74..4b5b4fc 100644
--- a/gcc/fortran/trans-stmt.h
+++ b/gcc/fortran/trans-stmt.h
@@ -56,6 +56,7 @@ tree gfc_trans_select (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 c6688d3..db0aa49 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -1828,6 +1828,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 512615a..c6b142f 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -776,6 +776,9 @@ 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_co_broadcast;
 extern GTY(()) tree gfor_fndecl_co_max;
 extern GTY(()) tree gfor_fndecl_co_min;

[-- Attachment #3: ChangeLog --]
[-- Type: application/octet-stream, Size: 1475 bytes --]

2016-06-06  Alessandro Fanfarillo  <fanfarillo.gcc@gmail.com>

	* check.c (gfc_check_image_status, gfc_check_failed_images):
	New functions.
	* dump-parse-tree.c: Define FAIL IMAGE statement.
	* gfortran.h (GFC_ISYM_FAILED_IMAGES, GFC_ISYM_IMAGE_STATUS)
	(EXEC_FAIL_IMAGE): New symbols.
	* intrinsic.c (failed_images, image_status): New functions.
	* intrinsic.h (gfc_check_failed_images, gfc_check_image_status)
	(gfc_resolve_failed_image, gfc_resolve_image_status): New prototypes.
	* iresolve.c (gfc_resolve_failed_images, gfc_resolve_image_status):
	New functions.
	* libgfortran.h (GFC_STAT_FAILED_IMAGES): New constant stat_code.
	* match.c (fail_image_statement, gfc_match_fail_image): New functions.
	* match.h (gfc_match_fail_image): New prototype.
	* parse.c (decode_statement): New match case for FAIL IMAGE.
	* resolve.c (resolve_fail_image): New function and case.
	* st.c (EXEC_FAIL_IMAGE): New case.
	* trans-decl.c (caf_fail_image, caf_failed_images, caf_image_status):
	New builtin functions declaration.
	* trans-expr.c (gfc_conv_procedure_call): New check for non-null variable.
	* trans-intrinsic.c (gfc_conv_intrinsic_image_status)
	(GFC_ISYM_FAILED_IMAGES): New function and case.
	* trans-stmt.c (gfc_trans_fail_image): New function.
	* trans-stmt.h (gfc_trans_fail_image): New prototype.
	* trans.c (EXEC_FAIL_IMAGE): New case.
	* trans.h (gfor_fndecl_caf_fail_image, gfor_fndecl_caf_failed_images)
	(gfor_fndecl_caf_image_status): New declarations.

Re: [Fortran, Patch] First patch for coarray FAILED IMAGES (TS 18508)

[Alessandro Fanfarillo]

* PING *

2016-06-06 15:05 GMT-06:00 Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>:
> Dear all,
>
> please find in attachment the first patch (of n) for the FAILED IMAGES
> capability defined in the coarray TS 18508.
> The patch adds support for three new intrinsic functions defined in
> the TS for simulating a failure (fail image), checking an image status
> (image_status) and getting the list of failed images (failed_images).
> The patch has been built and regtested on x86_64-pc-linux-gnu.
>
> Ok for trunk?
>
> Alessandro

Re: [Fortran, Patch] First patch for coarray FAILED IMAGES (TS 18508)

[Alessandro Fanfarillo]

* PING *

2016-06-21 10:59 GMT-06:00 Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>:
> * PING *
>
> 2016-06-06 15:05 GMT-06:00 Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>:
>> Dear all,
>>
>> please find in attachment the first patch (of n) for the FAILED IMAGES
>> capability defined in the coarray TS 18508.
>> The patch adds support for three new intrinsic functions defined in
>> the TS for simulating a failure (fail image), checking an image status
>> (image_status) and getting the list of failed images (failed_images).
>> The patch has been built and regtested on x86_64-pc-linux-gnu.
>>
>> Ok for trunk?
>>
>> Alessandro

Re: [Fortran, Patch] First patch for coarray FAILED IMAGES (TS 18508)

[Alessandro Fanfarillo]

Third *PING*

2016-07-04 16:46 GMT-06:00 Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>:
> * PING *
>
> 2016-06-21 10:59 GMT-06:00 Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>:
>> * PING *
>>
>> 2016-06-06 15:05 GMT-06:00 Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>:
>>> Dear all,
>>>
>>> please find in attachment the first patch (of n) for the FAILED IMAGES
>>> capability defined in the coarray TS 18508.
>>> The patch adds support for three new intrinsic functions defined in
>>> the TS for simulating a failure (fail image), checking an image status
>>> (image_status) and getting the list of failed images (failed_images).
>>> The patch has been built and regtested on x86_64-pc-linux-gnu.
>>>
>>> Ok for trunk?
>>>
>>> Alessandro

Re: [Fortran, Patch] First patch for coarray FAILED IMAGES (TS 18508)

[Mikael Morin]

Hello,

this is mostly good in general, but is lacking tests.
Especially, tests for successfull matching, and tests for every error 
you are adding in the patch (except maybe the -fcoarray= one).
Also tests that the code executes successfullly with -fcoarray=single, 
and that it produces the right function calls with -fcoarray=lib.

more specific comments below.

Mikael

Le 15/07/2016 à 19:34, Alessandro Fanfarillo a écrit :
> Third *PING*
>
> 2016-07-04 16:46 GMT-06:00 Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>:
>> * PING *
>>
>> 2016-06-21 10:59 GMT-06:00 Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>:
>>> * PING *
>>>
>>> 2016-06-06 15:05 GMT-06:00 Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>:
>>>> Dear all,
>>>>
>>>> please find in attachment the first patch (of n) for the FAILED IMAGES
>>>> capability defined in the coarray TS 18508.
>>>> The patch adds support for three new intrinsic functions defined in
>>>> the TS for simulating a failure (fail image), checking an image status
>>>> (image_status) and getting the list of failed images (failed_images).
>>>> The patch has been built and regtested on x86_64-pc-linux-gnu.
>>>>
>>>> Ok for trunk?
>>>>
>>>> Alessandro
>
> first_complete_patch.diff
>
> commit b3bca5b09f4cbcf18f2409dae2485a16a7c06498
> Author: Alessandro Fanfarillo <fanfarillo@ing.uniroma2.it>
> Date:   Mon Jun 6 14:27:37 2016 -0600
>
>     First patch Failed Images CAF TS-18508
>
> diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
> index f3a4a43..9f519ff 100644
> --- a/gcc/fortran/match.c
> +++ b/gcc/fortran/match.c
> @@ -1594,6 +1594,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)
> @@ -3073,6 +3074,41 @@ gfc_match_event_wait (void)
>    return event_statement (ST_EVENT_WAIT);
>  }
>
> +/* Match a FAIl IMAGE statement */
> +
> +static match
> +fail_image_statement (gfc_statement st)
> +{
> +  if (flag_coarray == GFC_FCOARRAY_NONE)
> +    {
> +      gfc_fatal_error ("Coarrays disabled at %C, use %<-fcoarray=%> to enable");
> +      return MATCH_ERROR;
> +    }
> +
> +  if (gfc_match_char ('(') == MATCH_YES)
> +    goto syntax;
> +
> +  if(st == ST_FAIL_IMAGE)
> +    new_st.op = EXEC_FAIL_IMAGE;
> +  else
> +    gcc_unreachable();
You can use
	gcc_assert (st == ST_FAIL_IMAGE);
	foo...;
instead of
	if (st == ST_FAIL_IMAGE)
		foo...;
	else
		gcc_unreachable ();
> +
> +  return MATCH_YES;
> +
> + syntax:
> +  gfc_syntax_error (st);
> +
> +  return MATCH_ERROR;
> +}
> +
> +match
> +gfc_match_fail_image (void)
> +{
> +  /* if (!gfc_notify_std (GFC_STD_F2008_TS, "FAIL IMAGE statement at %C")) */
> +  /*   return MATCH_ERROR; */
> +
Can this be uncommented?

> +  return fail_image_statement (ST_FAIL_IMAGE);
> +}
>
>  /* Match LOCK/UNLOCK statement. Syntax:
>       LOCK ( lock-variable [ , lock-stat-list ] )
> diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
> index 1aaf4e2..b2f5596 100644
> --- a/gcc/fortran/trans-intrinsic.c
> +++ b/gcc/fortran/trans-intrinsic.c
> @@ -1647,6 +1647,24 @@ trans_this_image (gfc_se * se, gfc_expr *expr)
>  					       m, lbound));
>  }
>
> +static void
> +gfc_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);
> +
> +  if (flag_coarray == GFC_FCOARRAY_LIB)
> +    {
Can everything be put under the if?
Does it work with -fcoarray=single?

> +      tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_image_status, 2,
> +  				 args[0], build_int_cst (integer_type_node, -1));
> +      se->expr = tmp;
> +    }
> +}
>
>  static void
> diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
> index 7d3cf8c..ce0eae7 100644
> --- a/gcc/fortran/trans-stmt.c
> +++ b/gcc/fortran/trans-stmt.c
> @@ -674,6 +674,31 @@ gfc_trans_stop (gfc_code *code, bool error_stop)
>    return gfc_finish_block (&se.pre);
>  }
>
> +/* Translate the FAIL IMAGE statement.  We have to translate this statement
> +   to a runtime library call.  */
> +
> +tree
> +gfc_trans_fail_image (gfc_code *code ATTRIBUTE_UNUSED)
> +{
> +  tree gfc_int4_type_node = gfc_get_int_type (4);
> +  gfc_se se;
> +  tree tmp;
> +
> +  /* Start a new block for this statement.  */
> +  gfc_init_se (&se, NULL);
> +  gfc_start_block (&se.pre);
> +
> +  tmp = build_int_cst (gfc_int4_type_node, 0);
This tmp doesn't seem to be used.

> +  tmp = build_call_expr_loc (input_location,
> +			     gfor_fndecl_caf_fail_image, 1,
> +			     build_int_cst (pchar_type_node, 0));
> +
> +  gfc_add_expr_to_block (&se.pre, tmp);
> +
> +  gfc_add_block_to_block (&se.pre, &se.post);
> +
> +  return gfc_finish_block (&se.pre);
> +}
>
>  tree
>  gfc_trans_lock_unlock (gfc_code *code, gfc_exec_op op)

Re: [Fortran, Patch] First patch for coarray FAILED IMAGES (TS 18508)

[Andre Vehreschild]

Hi Mikael,


> > +  if(st == ST_FAIL_IMAGE)
> > +    new_st.op = EXEC_FAIL_IMAGE;
> > +  else
> > +    gcc_unreachable();  
> You can use
> 	gcc_assert (st == ST_FAIL_IMAGE);
> 	foo...;
> instead of
> 	if (st == ST_FAIL_IMAGE)
> 		foo...;
> 	else
> 		gcc_unreachable ();

Be careful, this is not 100% identical in the general case. For older
gcc version (gcc < 4008) gcc_assert() is mapped to nothing, esp. not to
an abort(), so the behavior can change. But in this case everything is
fine, because the patch is most likely not backported.

> > +
> > +  return MATCH_YES;
> > +
> > + syntax:
> > +  gfc_syntax_error (st);
> > +
> > +  return MATCH_ERROR;
> > +}
> > +
> > +match
> > +gfc_match_fail_image (void)
> > +{
> > +  /* if (!gfc_notify_std (GFC_STD_F2008_TS, "FAIL IMAGE statement
> > at %C")) */
> > +  /*   return MATCH_ERROR; */
> > +  
> Can this be uncommented?
> 
> > +  return fail_image_statement (ST_FAIL_IMAGE);
> > +}
> >
> >  /* Match LOCK/UNLOCK statement. Syntax:
> >       LOCK ( lock-variable [ , lock-stat-list ] )
> > diff --git a/gcc/fortran/trans-intrinsic.c
> > b/gcc/fortran/trans-intrinsic.c index 1aaf4e2..b2f5596 100644
> > --- a/gcc/fortran/trans-intrinsic.c
> > +++ b/gcc/fortran/trans-intrinsic.c
> > @@ -1647,6 +1647,24 @@ trans_this_image (gfc_se * se, gfc_expr
> > *expr) m, lbound));
> >  }
> >
> > +static void
> > +gfc_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);
> > +
> > +  if (flag_coarray == GFC_FCOARRAY_LIB)
> > +    {  
> Can everything be put under the if?
> Does it work with -fcoarray=single?

IMO coarray=single should not generate code here, therefore putting
everything under the if should to fine.

Sorry for the comments ...

- Andre
-- 
Andre Vehreschild * Email: vehre ad gmx dot de 

Re: [Fortran, Patch] First patch for coarray FAILED IMAGES (TS 18508)

[Mikael Morin]

Le 20/07/2016 à 11:39, Andre Vehreschild a écrit :
> Hi Mikael,
>
>
>>> +  if(st == ST_FAIL_IMAGE)
>>> +    new_st.op = EXEC_FAIL_IMAGE;
>>> +  else
>>> +    gcc_unreachable();
>> You can use
>> 	gcc_assert (st == ST_FAIL_IMAGE);
>> 	foo...;
>> instead of
>> 	if (st == ST_FAIL_IMAGE)
>> 		foo...;
>> 	else
>> 		gcc_unreachable ();
>
> Be careful, this is not 100% identical in the general case. For older
> gcc version (gcc < 4008) gcc_assert() is mapped to nothing, esp. not to
> an abort(), so the behavior can change. But in this case everything is
> fine, because the patch is most likely not backported.
>
Didn't know about this. The difference seems to be very subtle.
I don't mind much anyway. The original version can stay if preferred, 
this was just a suggestion.

By the way, if the function is inlined in its single caller, the assert 
or unreachable statement can be removed, which avoids choosing between them.
That's another suggestion.

>>> +
>>> +  return MATCH_YES;
>>> +
>>> + syntax:
>>> +  gfc_syntax_error (st);
>>> +
>>> +  return MATCH_ERROR;
>>> +}
>>> +
>>> +match
>>> +gfc_match_fail_image (void)
>>> +{
>>> +  /* if (!gfc_notify_std (GFC_STD_F2008_TS, "FAIL IMAGE statement
>>> at %C")) */
>>> +  /*   return MATCH_ERROR; */
>>> +
>> Can this be uncommented?
>>
>>> +  return fail_image_statement (ST_FAIL_IMAGE);
>>> +}
>>>
>>>  /* Match LOCK/UNLOCK statement. Syntax:
>>>       LOCK ( lock-variable [ , lock-stat-list ] )
>>> diff --git a/gcc/fortran/trans-intrinsic.c
>>> b/gcc/fortran/trans-intrinsic.c index 1aaf4e2..b2f5596 100644
>>> --- a/gcc/fortran/trans-intrinsic.c
>>> +++ b/gcc/fortran/trans-intrinsic.c
>>> @@ -1647,6 +1647,24 @@ trans_this_image (gfc_se * se, gfc_expr
>>> *expr) m, lbound));
>>>  }
>>>
>>> +static void
>>> +gfc_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);
>>> +
>>> +  if (flag_coarray == GFC_FCOARRAY_LIB)
>>> +    {
>> Can everything be put under the if?
>> Does it work with -fcoarray=single?
>
> IMO coarray=single should not generate code here, therefore putting
> everything under the if should to fine.
>
My point was more avoiding generating code for the arguments if they are 
not used in the end.
Regarding the -fcoarray=single case, the function returns a result, 
which can be used in an expression, so I don't think it will work 
without at least hardcoding a fixed value as result in that case.
But even that wouldn't be enough, as the function wouldn't work 
consistently with the fail image statement.

> Sorry for the comments ...
>
Comments are welcome here, as far as I know. ;-)

Mikael

Re: [Fortran, Patch] First patch for coarray FAILED IMAGES (TS 18508)

[Alessandro Fanfarillo]

[-- Attachment #1: Type: text/plain, Size: 3300 bytes --]

Dear Mikael and all,

in attachment the new patch, built and regtested on x86_64-pc-linux-gnu.

Cheers,
Alessandro

2016-07-20 13:17 GMT-06:00 Mikael Morin <morin-mikael@orange.fr>:
> Le 20/07/2016 à 11:39, Andre Vehreschild a écrit :
>>
>> Hi Mikael,
>>
>>
>>>> +  if(st == ST_FAIL_IMAGE)
>>>> +    new_st.op = EXEC_FAIL_IMAGE;
>>>> +  else
>>>> +    gcc_unreachable();
>>>
>>> You can use
>>>         gcc_assert (st == ST_FAIL_IMAGE);
>>>         foo...;
>>> instead of
>>>         if (st == ST_FAIL_IMAGE)
>>>                 foo...;
>>>         else
>>>                 gcc_unreachable ();
>>
>>
>> Be careful, this is not 100% identical in the general case. For older
>> gcc version (gcc < 4008) gcc_assert() is mapped to nothing, esp. not to
>> an abort(), so the behavior can change. But in this case everything is
>> fine, because the patch is most likely not backported.
>>
> Didn't know about this. The difference seems to be very subtle.
> I don't mind much anyway. The original version can stay if preferred, this
> was just a suggestion.
>
> By the way, if the function is inlined in its single caller, the assert or
> unreachable statement can be removed, which avoids choosing between them.
> That's another suggestion.
>
>
>>>> +
>>>> +  return MATCH_YES;
>>>> +
>>>> + syntax:
>>>> +  gfc_syntax_error (st);
>>>> +
>>>> +  return MATCH_ERROR;
>>>> +}
>>>> +
>>>> +match
>>>> +gfc_match_fail_image (void)
>>>> +{
>>>> +  /* if (!gfc_notify_std (GFC_STD_F2008_TS, "FAIL IMAGE statement
>>>> at %C")) */
>>>> +  /*   return MATCH_ERROR; */
>>>> +
>>>
>>> Can this be uncommented?
>>>
>>>> +  return fail_image_statement (ST_FAIL_IMAGE);
>>>> +}
>>>>
>>>>  /* Match LOCK/UNLOCK statement. Syntax:
>>>>       LOCK ( lock-variable [ , lock-stat-list ] )
>>>> diff --git a/gcc/fortran/trans-intrinsic.c
>>>> b/gcc/fortran/trans-intrinsic.c index 1aaf4e2..b2f5596 100644
>>>> --- a/gcc/fortran/trans-intrinsic.c
>>>> +++ b/gcc/fortran/trans-intrinsic.c
>>>> @@ -1647,6 +1647,24 @@ trans_this_image (gfc_se * se, gfc_expr
>>>> *expr) m, lbound));
>>>>  }
>>>>
>>>> +static void
>>>> +gfc_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);
>>>> +
>>>> +  if (flag_coarray == GFC_FCOARRAY_LIB)
>>>> +    {
>>>
>>> Can everything be put under the if?
>>> Does it work with -fcoarray=single?
>>
>>
>> IMO coarray=single should not generate code here, therefore putting
>> everything under the if should to fine.
>>
> My point was more avoiding generating code for the arguments if they are not
> used in the end.
> Regarding the -fcoarray=single case, the function returns a result, which
> can be used in an expression, so I don't think it will work without at least
> hardcoding a fixed value as result in that case.
> But even that wouldn't be enough, as the function wouldn't work consistently
> with the fail image statement.
>
>> Sorry for the comments ...
>>
> Comments are welcome here, as far as I know. ;-)
>
> Mikael

[-- Attachment #2: first_complete_patch_REV1.diff --]
[-- Type: text/plain, Size: 23449 bytes --]

commit d6c91b2c14a12d1d012738f13f4920e207113982
Author: Alessandro Fanfarillo <elfanfa@ucar.edu>
Date:   Thu Jul 21 10:01:33 2016 -0600

    First review of failed images patch

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index d26e45e..121551c 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -1210,6 +1210,97 @@ gfc_check_event_query (gfc_expr *event, gfc_expr *count, gfc_expr *stat)
   return true;
 }
 
+bool
+gfc_check_image_status (gfc_expr *image, gfc_expr *team)
+{
+
+  if (flag_coarray != GFC_FCOARRAY_LIB)
+    {
+      gfc_fatal_error ("Failed images features "
+		       "usable only with %<-fcoarray=lib%>");
+      return false;
+    }
+
+  if (!type_check (image, 1, BT_INTEGER))
+    return false;
+
+  int i = gfc_validate_kind (BT_INTEGER, image->ts.kind, false);
+  int j = gfc_validate_kind (BT_INTEGER, gfc_default_integer_kind, false);
+
+  if (gfc_integer_kinds[i].range < gfc_integer_kinds[j].range)
+    {
+      gfc_error ("IMAGE argument of the IMAGE_STATUS intrinsic function at %L "
+		 "shall have at least the range of the default integer",
+		 &image->where);
+      return false;
+    }
+
+  j = gfc_validate_kind (BT_INTEGER, gfc_default_integer_kind*2, false);
+
+  if (gfc_integer_kinds[i].range > gfc_integer_kinds[j].range)
+    {
+      gfc_error ("IMAGE argument of the IMAGE_STATUS intrinsic function at %L "
+		 "shall have at most the range of the double precision integer",
+		 &image->where);
+      return false;
+    }
+
+  if (team)
+    {
+      gfc_error ("TEAM argument of the IMAGE_STATUS intrinsic function at %L "
+		 "not yet supported",
+		 &team->where);
+      return false;
+    }
+
+  return true;
+}
+
+bool
+gfc_check_failed_images (gfc_expr *team, gfc_expr *kind)
+{
+  if (flag_coarray != GFC_FCOARRAY_LIB)
+    {
+      gfc_fatal_error ("Failed images feature "
+		       "usable only with %<-fcoarray=lib%>");
+      return false;
+    }
+
+  if (team)
+    {
+      gfc_error ("TEAM argument of the FAILED_IMAGES intrinsic function "
+		 "at %L not yet supported", &team->where);
+      return false;
+    }
+
+  if (kind)
+    {
+      int i = gfc_validate_kind (BT_INTEGER, kind->ts.kind, false);
+      int j = gfc_validate_kind (BT_INTEGER, gfc_default_integer_kind, false);
+
+      if (gfc_integer_kinds[i].range < gfc_integer_kinds[j].range)
+	{
+	  gfc_error ("KIND argument of the FAILED_IMAGES intrinsic function "
+		     "at %L shall have at least the range "
+		     "of the default integer", &kind->where);
+	  return false;
+	}
+
+      j = gfc_validate_kind (BT_INTEGER, gfc_default_integer_kind*2, false);
+
+      if (gfc_integer_kinds[i].range > gfc_integer_kinds[j].range)
+	{
+	  gfc_error ("KIND argument of the FAILED_IMAGES "
+		     "intrinsic function at %L shall have at most the "
+		     "range of the double precision integer",
+		     &kind->where);
+	  return false;
+	}
+    }
+
+  return true;
+}
+
 
 bool
 gfc_check_atomic_fetch_op (gfc_expr *atom, gfc_expr *value, gfc_expr *old,
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index f507434..41ed664 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1628,6 +1628,9 @@ show_code_node (int level, gfc_code *c)
 
       break;
 
+    case EXEC_FAIL_IMAGE:
+      fputs ("FAIL IMAGE ", dumpfile);
+
     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 77831ab..2f22c32 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -253,7 +253,7 @@ enum gfc_statement
   ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD,
   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
@@ -411,6 +411,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,
@@ -454,6 +455,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,
@@ -2383,7 +2385,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/intrinsic.c b/gcc/fortran/intrinsic.c
index 1d7503d..a6421b5 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -1823,6 +1823,10 @@ 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_images, NULL,
+	     gfc_resolve_failed_images, "team", BT_INTEGER, 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);
 
@@ -2024,6 +2028,10 @@ 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, NULL,
+	     gfc_resolve_image_status, "image", BT_INTEGER, di, REQUIRED, "team", BT_INTEGER, 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,
diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h
index f228976..bb49b7d 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_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 *);
@@ -467,6 +469,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 *);
@@ -490,6 +493,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 *);
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index ecea1c3..c142eca 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -2577,6 +2577,29 @@ gfc_resolve_tanh (gfc_expr *f, gfc_expr *x)
     = gfc_get_string ("__tanh_%c%d", gfc_type_letter (x->ts.type), x->ts.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
+    f->ts.kind = kind->ts.kind;
+  f->value.function.name = failed_images;
+}
+
+void
+gfc_resolve_image_status (gfc_expr *f, gfc_expr *image, gfc_expr *team ATTRIBUTE_UNUSED)
+{
+  static char image_status[] = "image_status";
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_default_integer_kind;
+  f->ts = image->ts;
+  f->value.function.name = image_status;
+}
 
 void
 gfc_resolve_image_index (gfc_expr *f, gfc_expr *array ATTRIBUTE_UNUSED,
diff --git a/gcc/fortran/libgfortran.h b/gcc/fortran/libgfortran.h
index e913250..f00ed83 100644
--- a/gcc/fortran/libgfortran.h
+++ b/gcc/fortran/libgfortran.h
@@ -123,7 +123,7 @@ typedef enum
   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 f3a4a43..5a13cc3 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -1594,6 +1594,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)
@@ -3073,6 +3074,41 @@ gfc_match_event_wait (void)
   return event_statement (ST_EVENT_WAIT);
 }
 
+/* Match a FAIL IMAGE statement.  */
+
+static match
+fail_image_statement (gfc_statement st)
+{
+  if (flag_coarray != GFC_FCOARRAY_LIB)
+    {
+      gfc_fatal_error ("Failed images features"
+		       "usable only with %<-fcoarray=lib%>");
+      return MATCH_ERROR;
+    }
+
+  if (gfc_match_char ('(') == MATCH_YES)
+    goto syntax;
+
+  gcc_assert (st == ST_FAIL_IMAGE);
+
+  new_st.op = EXEC_FAIL_IMAGE;
+
+  return MATCH_YES;
+
+ syntax:
+  gfc_syntax_error (st);
+
+  return MATCH_ERROR;
+}
+
+match
+gfc_match_fail_image (void)
+{
+  if (!gfc_notify_std (GFC_STD_F2008_TS, "FAIL IMAGE statement at %C"))
+    return MATCH_ERROR;
+
+  return fail_image_statement (ST_FAIL_IMAGE);
+}
 
 /* Match LOCK/UNLOCK statement. Syntax:
      LOCK ( lock-variable [ , lock-stat-list ] )
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index 348ca70..4e4b833 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -72,6 +72,7 @@ match gfc_match_else (void);
 match gfc_match_elseif (void);
 match gfc_match_event_post (void);
 match gfc_match_event_wait (void);
+match gfc_match_fail_image (void);
 match gfc_match_critical (void);
 match gfc_match_block (void);
 match gfc_match_associate (void);
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index bd7b138..bb6e1f5 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -483,6 +483,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);
@@ -1425,7 +1426,7 @@ next_statement (void)
   case ST_OMP_CANCEL: case ST_OMP_CANCELLATION_POINT: \
   case ST_OMP_TARGET_UPDATE: 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
 
@@ -1751,6 +1752,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 1fc540a..475d600 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -8779,6 +8779,11 @@ find_reachable_labels (gfc_code *block)
     }
 }
 
+static void
+resolve_fail_image (gfc_code *code ATTRIBUTE_UNUSED)
+{
+  return;
+}
 
 static void
 resolve_lock_unlock_event (gfc_code *code)
@@ -10509,6 +10514,10 @@ start:
 	  resolve_lock_unlock_event (code);
 	  break;
 
+	case EXEC_FAIL_IMAGE:
+	  resolve_fail_image (code);
+	  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/st.c b/gcc/fortran/st.c
index 7395497..b3a6721 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 69ddd17..be62581 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -151,6 +151,9 @@ 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_co_broadcast;
 tree gfor_fndecl_co_max;
 tree gfor_fndecl_co_min;
@@ -3664,6 +3667,18 @@ 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_with_spec (
+	get_identifier (PREFIX("caf_fail_image")), "R",
+	void_type_node, 1, pvoid_type_node);
+
+      gfor_fndecl_caf_failed_images = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("caf_failed_images")), "WRR",
+	pvoid_type_node, 3, pvoid_type_node, integer_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, 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 e3559f4..0f26e7e 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -6132,10 +6132,11 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
          components must have the result allocatable components copied.  */
       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 c655540..460de52 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -1677,6 +1677,19 @@ trans_this_image (gfc_se * se, gfc_expr *expr)
 					       m, lbound));
 }
 
+static void
+gfc_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);
+  tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_image_status, 2,
+			     args[0], build_int_cst (integer_type_node, -1));
+  se->expr = tmp;
+}
 
 static void
 trans_image_index (gfc_se * se, gfc_expr *expr)
@@ -8333,6 +8346,10 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
       trans_image_index (se, expr);
       break;
 
+    case GFC_ISYM_IMAGE_STATUS:
+      gfc_conv_intrinsic_image_status (se, expr);
+      break;
+
     case GFC_ISYM_NUM_IMAGES:
       trans_num_images (se, expr);
       break;
@@ -8683,10 +8700,11 @@ 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_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 6e4e2a7..b640f91 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -674,6 +674,27 @@ gfc_trans_stop (gfc_code *code, bool error_stop)
   return gfc_finish_block (&se.pre);
 }
 
+/* Translate the FAIL IMAGE statement.  We have to translate this statement
+   to a runtime library call.  */
+
+tree
+gfc_trans_fail_image (gfc_code *code ATTRIBUTE_UNUSED)
+{
+  gfc_se se;
+  tree tmp;
+
+  /* Start a new block for this statement.  */
+  gfc_init_se (&se, NULL);
+  gfc_start_block (&se.pre);
+
+  tmp = build_call_expr_loc (input_location,
+			     gfor_fndecl_caf_fail_image, 1,
+			     build_int_cst (pchar_type_node, 0));
+
+  gfc_add_expr_to_block (&se.pre, tmp);
+  gfc_add_block_to_block (&se.pre, &se.post);
+  return gfc_finish_block (&se.pre);
+}
 
 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 f9c8e74..4b5b4fc 100644
--- a/gcc/fortran/trans-stmt.h
+++ b/gcc/fortran/trans-stmt.h
@@ -56,6 +56,7 @@ tree gfc_trans_select (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 28d1341..1f5d7f3 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -1826,6 +1826,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 512615a..c6b142f 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -776,6 +776,9 @@ 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_co_broadcast;
 extern GTY(()) tree gfor_fndecl_co_max;
 extern GTY(()) tree gfor_fndecl_co_min;
diff --git a/gcc/testsuite/gfortran.dg/coarray_fail_st.f90 b/gcc/testsuite/gfortran.dg/coarray_fail_st.f90
new file mode 100644
index 0000000..7d4dc38
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_fail_st.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original -fcoarray=lib" }
+!
+program fail_statement
+  implicit none
+
+  integer :: me,np,stat
+
+  me = this_image()
+  np = num_images()
+  stat = 0
+
+  if(me == 1) fail image
+
+  sync all(stat=stat)
+
+  if(stat /= 0) write(*,*) 'Image failed during sync'
+
+end program fail_statement
+
+! { dg-final { scan-tree-dump-times "_gfortran_caf_fail_image \\\(0B\\\);" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/coarray_failed_images.f90 b/gcc/testsuite/gfortran.dg/coarray_failed_images.f90
new file mode 100644
index 0000000..b64ed25
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_failed_images.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original -fcoarray=lib" }
+!
+program test_failed_images
+  implicit none
+
+  integer :: me,np,stat
+  character(len=1) :: c
+
+  me = this_image()
+  np = num_images()
+  stat = 0
+
+  sync all(stat=stat)
+
+  if(stat /= 0) then
+     write(*,*) failed_images()
+  endif
+end program test_failed_images
+
+! { dg-final { scan-tree-dump-times "_gfortran_caf_failed_images \\\(&atmp.1, 0B, 0B\\\);" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/coarray_failed_images_err.f90 b/gcc/testsuite/gfortran.dg/coarray_failed_images_err.f90
new file mode 100644
index 0000000..4aa6229
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_failed_images_err.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original -fcoarray=lib" }
+!
+program test_failed_images_err
+  implicit none
+
+  integer :: me,np,stat
+  character(len=1) :: c
+
+  me = this_image()
+  np = num_images()
+  stat = 0
+
+  sync all(stat=stat)
+
+  if(stat /= 0) then
+     write(*,*) failed_images(me) ! { dg-error "TEAM argument of the FAILED_IMAGES intrinsic function at .1. not yet supported" }
+  endif
+end program test_failed_images_err
diff --git a/gcc/testsuite/gfortran.dg/coarray_image_status.f90 b/gcc/testsuite/gfortran.dg/coarray_image_status.f90
new file mode 100644
index 0000000..9145da7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_image_status.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original -fcoarray=lib" }
+!
+program test_image_status
+  implicit none
+
+  integer :: me,np,stat
+  character(len=1) :: c
+
+  me = this_image()
+  np = num_images()
+  stat = 0
+
+  sync all(stat=stat)
+
+  if(stat /= 0) then
+     write(*,*) image_status(1)
+  endif
+end program test_image_status
+
+! { dg-final { scan-tree-dump-times "_gfortran_caf_image_status \\\(1, -1\\\);" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/coarray_image_status_err.f90 b/gcc/testsuite/gfortran.dg/coarray_image_status_err.f90
new file mode 100644
index 0000000..554e513
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_image_status_err.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original -fcoarray=lib" }
+!
+program test_image_status_err
+  implicit none
+
+  integer :: me,np,stat
+  character(len=1) :: c
+
+  me = this_image()
+  np = num_images()
+  stat = 0
+
+  sync all(stat=stat)
+
+  if(stat /= 0) then
+     write(*,*) image_status(1,team=1) ! { dg-error "TEAM argument of the IMAGE_STATUS intrinsic function at .1. not yet supported" }
+  endif
+end program test_image_status_err

Re: [Fortran, Patch] First patch for coarray FAILED IMAGES (TS 18508)

[Alessandro Fanfarillo]

* PING *

2016-07-21 13:05 GMT-06:00 Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>:
> Dear Mikael and all,
>
> in attachment the new patch, built and regtested on x86_64-pc-linux-gnu.
>
> Cheers,
> Alessandro
>
> 2016-07-20 13:17 GMT-06:00 Mikael Morin <morin-mikael@orange.fr>:
>> Le 20/07/2016 à 11:39, Andre Vehreschild a écrit :
>>>
>>> Hi Mikael,
>>>
>>>
>>>>> +  if(st == ST_FAIL_IMAGE)
>>>>> +    new_st.op = EXEC_FAIL_IMAGE;
>>>>> +  else
>>>>> +    gcc_unreachable();
>>>>
>>>> You can use
>>>>         gcc_assert (st == ST_FAIL_IMAGE);
>>>>         foo...;
>>>> instead of
>>>>         if (st == ST_FAIL_IMAGE)
>>>>                 foo...;
>>>>         else
>>>>                 gcc_unreachable ();
>>>
>>>
>>> Be careful, this is not 100% identical in the general case. For older
>>> gcc version (gcc < 4008) gcc_assert() is mapped to nothing, esp. not to
>>> an abort(), so the behavior can change. But in this case everything is
>>> fine, because the patch is most likely not backported.
>>>
>> Didn't know about this. The difference seems to be very subtle.
>> I don't mind much anyway. The original version can stay if preferred, this
>> was just a suggestion.
>>
>> By the way, if the function is inlined in its single caller, the assert or
>> unreachable statement can be removed, which avoids choosing between them.
>> That's another suggestion.
>>
>>
>>>>> +
>>>>> +  return MATCH_YES;
>>>>> +
>>>>> + syntax:
>>>>> +  gfc_syntax_error (st);
>>>>> +
>>>>> +  return MATCH_ERROR;
>>>>> +}
>>>>> +
>>>>> +match
>>>>> +gfc_match_fail_image (void)
>>>>> +{
>>>>> +  /* if (!gfc_notify_std (GFC_STD_F2008_TS, "FAIL IMAGE statement
>>>>> at %C")) */
>>>>> +  /*   return MATCH_ERROR; */
>>>>> +
>>>>
>>>> Can this be uncommented?
>>>>
>>>>> +  return fail_image_statement (ST_FAIL_IMAGE);
>>>>> +}
>>>>>
>>>>>  /* Match LOCK/UNLOCK statement. Syntax:
>>>>>       LOCK ( lock-variable [ , lock-stat-list ] )
>>>>> diff --git a/gcc/fortran/trans-intrinsic.c
>>>>> b/gcc/fortran/trans-intrinsic.c index 1aaf4e2..b2f5596 100644
>>>>> --- a/gcc/fortran/trans-intrinsic.c
>>>>> +++ b/gcc/fortran/trans-intrinsic.c
>>>>> @@ -1647,6 +1647,24 @@ trans_this_image (gfc_se * se, gfc_expr
>>>>> *expr) m, lbound));
>>>>>  }
>>>>>
>>>>> +static void
>>>>> +gfc_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);
>>>>> +
>>>>> +  if (flag_coarray == GFC_FCOARRAY_LIB)
>>>>> +    {
>>>>
>>>> Can everything be put under the if?
>>>> Does it work with -fcoarray=single?
>>>
>>>
>>> IMO coarray=single should not generate code here, therefore putting
>>> everything under the if should to fine.
>>>
>> My point was more avoiding generating code for the arguments if they are not
>> used in the end.
>> Regarding the -fcoarray=single case, the function returns a result, which
>> can be used in an expression, so I don't think it will work without at least
>> hardcoding a fixed value as result in that case.
>> But even that wouldn't be enough, as the function wouldn't work consistently
>> with the fail image statement.
>>
>>> Sorry for the comments ...
>>>
>> Comments are welcome here, as far as I know. ;-)
>>
>> Mikael

Re: [Fortran, Patch] First patch for coarray FAILED IMAGES (TS 18508)

[Paul Richard Thomas]

Hi Sandro,

As far as I can see, this is OK barring a couple of minor wrinkles and
a question:

For coarray_failed_images_err.f90 and coarray_image_status_err.f90 you
have used the option -fdump-tree-original without making use of the
tree dump.

Mikael asked you to provide an executable test with -fcoarray=single.
Is this not possible for some reason?

Otherwise, this is OK for trunk.

Thanks for the patch.

Paul

On 4 August 2016 at 05:07, Alessandro Fanfarillo
<fanfarillo.gcc@gmail.com> wrote:
> * PING *
>
> 2016-07-21 13:05 GMT-06:00 Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>:
>> Dear Mikael and all,
>>
>> in attachment the new patch, built and regtested on x86_64-pc-linux-gnu.
>>
>> Cheers,
>> Alessandro
>>
>> 2016-07-20 13:17 GMT-06:00 Mikael Morin <morin-mikael@orange.fr>:
>>> Le 20/07/2016 à 11:39, Andre Vehreschild a écrit :
>>>>
>>>> Hi Mikael,
>>>>
>>>>
>>>>>> +  if(st == ST_FAIL_IMAGE)
>>>>>> +    new_st.op = EXEC_FAIL_IMAGE;
>>>>>> +  else
>>>>>> +    gcc_unreachable();
>>>>>
>>>>> You can use
>>>>>         gcc_assert (st == ST_FAIL_IMAGE);
>>>>>         foo...;
>>>>> instead of
>>>>>         if (st == ST_FAIL_IMAGE)
>>>>>                 foo...;
>>>>>         else
>>>>>                 gcc_unreachable ();
>>>>
>>>>
>>>> Be careful, this is not 100% identical in the general case. For older
>>>> gcc version (gcc < 4008) gcc_assert() is mapped to nothing, esp. not to
>>>> an abort(), so the behavior can change. But in this case everything is
>>>> fine, because the patch is most likely not backported.
>>>>
>>> Didn't know about this. The difference seems to be very subtle.
>>> I don't mind much anyway. The original version can stay if preferred, this
>>> was just a suggestion.
>>>
>>> By the way, if the function is inlined in its single caller, the assert or
>>> unreachable statement can be removed, which avoids choosing between them.
>>> That's another suggestion.
>>>
>>>
>>>>>> +
>>>>>> +  return MATCH_YES;
>>>>>> +
>>>>>> + syntax:
>>>>>> +  gfc_syntax_error (st);
>>>>>> +
>>>>>> +  return MATCH_ERROR;
>>>>>> +}
>>>>>> +
>>>>>> +match
>>>>>> +gfc_match_fail_image (void)
>>>>>> +{
>>>>>> +  /* if (!gfc_notify_std (GFC_STD_F2008_TS, "FAIL IMAGE statement
>>>>>> at %C")) */
>>>>>> +  /*   return MATCH_ERROR; */
>>>>>> +
>>>>>
>>>>> Can this be uncommented?
>>>>>
>>>>>> +  return fail_image_statement (ST_FAIL_IMAGE);
>>>>>> +}
>>>>>>
>>>>>>  /* Match LOCK/UNLOCK statement. Syntax:
>>>>>>       LOCK ( lock-variable [ , lock-stat-list ] )
>>>>>> diff --git a/gcc/fortran/trans-intrinsic.c
>>>>>> b/gcc/fortran/trans-intrinsic.c index 1aaf4e2..b2f5596 100644
>>>>>> --- a/gcc/fortran/trans-intrinsic.c
>>>>>> +++ b/gcc/fortran/trans-intrinsic.c
>>>>>> @@ -1647,6 +1647,24 @@ trans_this_image (gfc_se * se, gfc_expr
>>>>>> *expr) m, lbound));
>>>>>>  }
>>>>>>
>>>>>> +static void
>>>>>> +gfc_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);
>>>>>> +
>>>>>> +  if (flag_coarray == GFC_FCOARRAY_LIB)
>>>>>> +    {
>>>>>
>>>>> Can everything be put under the if?
>>>>> Does it work with -fcoarray=single?
>>>>
>>>>
>>>> IMO coarray=single should not generate code here, therefore putting
>>>> everything under the if should to fine.
>>>>
>>> My point was more avoiding generating code for the arguments if they are not
>>> used in the end.
>>> Regarding the -fcoarray=single case, the function returns a result, which
>>> can be used in an expression, so I don't think it will work without at least
>>> hardcoding a fixed value as result in that case.
>>> But even that wouldn't be enough, as the function wouldn't work consistently
>>> with the fail image statement.
>>>
>>>> Sorry for the comments ...
>>>>
>>> Comments are welcome here, as far as I know. ;-)
>>>
>>> Mikael



-- 
The difference between genius and stupidity is; genius has its limits.

Albert Einstein

Re: [Fortran, Patch] First patch for coarray FAILED IMAGES (TS 18508)

[Alessandro Fanfarillo]

Thanks Paul,

I fixed the unused -fdump-tree-original on the tests.

About -fcoarray=single, I agree with Andre about not producing code
for failed images functions when running in single-image mode. If you,
or anybody else, thing otherwise I can adjust the functions to return
a constant value (except for fail image... :)).


2016-08-09 5:22 GMT-06:00 Paul Richard Thomas <paul.richard.thomas@gmail.com>:
> Hi Sandro,
>
> As far as I can see, this is OK barring a couple of minor wrinkles and
> a question:
>
> For coarray_failed_images_err.f90 and coarray_image_status_err.f90 you
> have used the option -fdump-tree-original without making use of the
> tree dump.
>
> Mikael asked you to provide an executable test with -fcoarray=single.
> Is this not possible for some reason?
>
> Otherwise, this is OK for trunk.
>
> Thanks for the patch.
>
> Paul
>
> On 4 August 2016 at 05:07, Alessandro Fanfarillo
> <fanfarillo.gcc@gmail.com> wrote:
>> * PING *
>>
>> 2016-07-21 13:05 GMT-06:00 Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>:
>>> Dear Mikael and all,
>>>
>>> in attachment the new patch, built and regtested on x86_64-pc-linux-gnu.
>>>
>>> Cheers,
>>> Alessandro
>>>
>>> 2016-07-20 13:17 GMT-06:00 Mikael Morin <morin-mikael@orange.fr>:
>>>> Le 20/07/2016 à 11:39, Andre Vehreschild a écrit :
>>>>>
>>>>> Hi Mikael,
>>>>>
>>>>>
>>>>>>> +  if(st == ST_FAIL_IMAGE)
>>>>>>> +    new_st.op = EXEC_FAIL_IMAGE;
>>>>>>> +  else
>>>>>>> +    gcc_unreachable();
>>>>>>
>>>>>> You can use
>>>>>>         gcc_assert (st == ST_FAIL_IMAGE);
>>>>>>         foo...;
>>>>>> instead of
>>>>>>         if (st == ST_FAIL_IMAGE)
>>>>>>                 foo...;
>>>>>>         else
>>>>>>                 gcc_unreachable ();
>>>>>
>>>>>
>>>>> Be careful, this is not 100% identical in the general case. For older
>>>>> gcc version (gcc < 4008) gcc_assert() is mapped to nothing, esp. not to
>>>>> an abort(), so the behavior can change. But in this case everything is
>>>>> fine, because the patch is most likely not backported.
>>>>>
>>>> Didn't know about this. The difference seems to be very subtle.
>>>> I don't mind much anyway. The original version can stay if preferred, this
>>>> was just a suggestion.
>>>>
>>>> By the way, if the function is inlined in its single caller, the assert or
>>>> unreachable statement can be removed, which avoids choosing between them.
>>>> That's another suggestion.
>>>>
>>>>
>>>>>>> +
>>>>>>> +  return MATCH_YES;
>>>>>>> +
>>>>>>> + syntax:
>>>>>>> +  gfc_syntax_error (st);
>>>>>>> +
>>>>>>> +  return MATCH_ERROR;
>>>>>>> +}
>>>>>>> +
>>>>>>> +match
>>>>>>> +gfc_match_fail_image (void)
>>>>>>> +{
>>>>>>> +  /* if (!gfc_notify_std (GFC_STD_F2008_TS, "FAIL IMAGE statement
>>>>>>> at %C")) */
>>>>>>> +  /*   return MATCH_ERROR; */
>>>>>>> +
>>>>>>
>>>>>> Can this be uncommented?
>>>>>>
>>>>>>> +  return fail_image_statement (ST_FAIL_IMAGE);
>>>>>>> +}
>>>>>>>
>>>>>>>  /* Match LOCK/UNLOCK statement. Syntax:
>>>>>>>       LOCK ( lock-variable [ , lock-stat-list ] )
>>>>>>> diff --git a/gcc/fortran/trans-intrinsic.c
>>>>>>> b/gcc/fortran/trans-intrinsic.c index 1aaf4e2..b2f5596 100644
>>>>>>> --- a/gcc/fortran/trans-intrinsic.c
>>>>>>> +++ b/gcc/fortran/trans-intrinsic.c
>>>>>>> @@ -1647,6 +1647,24 @@ trans_this_image (gfc_se * se, gfc_expr
>>>>>>> *expr) m, lbound));
>>>>>>>  }
>>>>>>>
>>>>>>> +static void
>>>>>>> +gfc_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);
>>>>>>> +
>>>>>>> +  if (flag_coarray == GFC_FCOARRAY_LIB)
>>>>>>> +    {
>>>>>>
>>>>>> Can everything be put under the if?
>>>>>> Does it work with -fcoarray=single?
>>>>>
>>>>>
>>>>> IMO coarray=single should not generate code here, therefore putting
>>>>> everything under the if should to fine.
>>>>>
>>>> My point was more avoiding generating code for the arguments if they are not
>>>> used in the end.
>>>> Regarding the -fcoarray=single case, the function returns a result, which
>>>> can be used in an expression, so I don't think it will work without at least
>>>> hardcoding a fixed value as result in that case.
>>>> But even that wouldn't be enough, as the function wouldn't work consistently
>>>> with the fail image statement.
>>>>
>>>>> Sorry for the comments ...
>>>>>
>>>> Comments are welcome here, as far as I know. ;-)
>>>>
>>>> Mikael
>
>
>
> --
> The difference between genius and stupidity is; genius has its limits.
>
> Albert Einstein

Re: [Fortran, Patch] First patch for coarray FAILED IMAGES (TS 18508)

[Alessandro Fanfarillo]

[-- Attachment #1: Type: text/plain, Size: 4635 bytes --]

Dear all,
the attached patch supports failed images also when -fcoarray=single is used.

Built and regtested on x86_64-pc-linux-gnu.

Cheers,
Alessandro

2016-08-09 5:22 GMT-06:00 Paul Richard Thomas <paul.richard.thomas@gmail.com>:
> Hi Sandro,
>
> As far as I can see, this is OK barring a couple of minor wrinkles and
> a question:
>
> For coarray_failed_images_err.f90 and coarray_image_status_err.f90 you
> have used the option -fdump-tree-original without making use of the
> tree dump.
>
> Mikael asked you to provide an executable test with -fcoarray=single.
> Is this not possible for some reason?
>
> Otherwise, this is OK for trunk.
>
> Thanks for the patch.
>
> Paul
>
> On 4 August 2016 at 05:07, Alessandro Fanfarillo
> <fanfarillo.gcc@gmail.com> wrote:
>> * PING *
>>
>> 2016-07-21 13:05 GMT-06:00 Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>:
>>> Dear Mikael and all,
>>>
>>> in attachment the new patch, built and regtested on x86_64-pc-linux-gnu.
>>>
>>> Cheers,
>>> Alessandro
>>>
>>> 2016-07-20 13:17 GMT-06:00 Mikael Morin <morin-mikael@orange.fr>:
>>>> Le 20/07/2016 à 11:39, Andre Vehreschild a écrit :
>>>>>
>>>>> Hi Mikael,
>>>>>
>>>>>
>>>>>>> +  if(st == ST_FAIL_IMAGE)
>>>>>>> +    new_st.op = EXEC_FAIL_IMAGE;
>>>>>>> +  else
>>>>>>> +    gcc_unreachable();
>>>>>>
>>>>>> You can use
>>>>>>         gcc_assert (st == ST_FAIL_IMAGE);
>>>>>>         foo...;
>>>>>> instead of
>>>>>>         if (st == ST_FAIL_IMAGE)
>>>>>>                 foo...;
>>>>>>         else
>>>>>>                 gcc_unreachable ();
>>>>>
>>>>>
>>>>> Be careful, this is not 100% identical in the general case. For older
>>>>> gcc version (gcc < 4008) gcc_assert() is mapped to nothing, esp. not to
>>>>> an abort(), so the behavior can change. But in this case everything is
>>>>> fine, because the patch is most likely not backported.
>>>>>
>>>> Didn't know about this. The difference seems to be very subtle.
>>>> I don't mind much anyway. The original version can stay if preferred, this
>>>> was just a suggestion.
>>>>
>>>> By the way, if the function is inlined in its single caller, the assert or
>>>> unreachable statement can be removed, which avoids choosing between them.
>>>> That's another suggestion.
>>>>
>>>>
>>>>>>> +
>>>>>>> +  return MATCH_YES;
>>>>>>> +
>>>>>>> + syntax:
>>>>>>> +  gfc_syntax_error (st);
>>>>>>> +
>>>>>>> +  return MATCH_ERROR;
>>>>>>> +}
>>>>>>> +
>>>>>>> +match
>>>>>>> +gfc_match_fail_image (void)
>>>>>>> +{
>>>>>>> +  /* if (!gfc_notify_std (GFC_STD_F2008_TS, "FAIL IMAGE statement
>>>>>>> at %C")) */
>>>>>>> +  /*   return MATCH_ERROR; */
>>>>>>> +
>>>>>>
>>>>>> Can this be uncommented?
>>>>>>
>>>>>>> +  return fail_image_statement (ST_FAIL_IMAGE);
>>>>>>> +}
>>>>>>>
>>>>>>>  /* Match LOCK/UNLOCK statement. Syntax:
>>>>>>>       LOCK ( lock-variable [ , lock-stat-list ] )
>>>>>>> diff --git a/gcc/fortran/trans-intrinsic.c
>>>>>>> b/gcc/fortran/trans-intrinsic.c index 1aaf4e2..b2f5596 100644
>>>>>>> --- a/gcc/fortran/trans-intrinsic.c
>>>>>>> +++ b/gcc/fortran/trans-intrinsic.c
>>>>>>> @@ -1647,6 +1647,24 @@ trans_this_image (gfc_se * se, gfc_expr
>>>>>>> *expr) m, lbound));
>>>>>>>  }
>>>>>>>
>>>>>>> +static void
>>>>>>> +gfc_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);
>>>>>>> +
>>>>>>> +  if (flag_coarray == GFC_FCOARRAY_LIB)
>>>>>>> +    {
>>>>>>
>>>>>> Can everything be put under the if?
>>>>>> Does it work with -fcoarray=single?
>>>>>
>>>>>
>>>>> IMO coarray=single should not generate code here, therefore putting
>>>>> everything under the if should to fine.
>>>>>
>>>> My point was more avoiding generating code for the arguments if they are not
>>>> used in the end.
>>>> Regarding the -fcoarray=single case, the function returns a result, which
>>>> can be used in an expression, so I don't think it will work without at least
>>>> hardcoding a fixed value as result in that case.
>>>> But even that wouldn't be enough, as the function wouldn't work consistently
>>>> with the fail image statement.
>>>>
>>>>> Sorry for the comments ...
>>>>>
>>>> Comments are welcome here, as far as I know. ;-)
>>>>
>>>> Mikael
>
>
>
> --
> The difference between genius and stupidity is; genius has its limits.
>
> Albert Einstein

[-- Attachment #2: first_complete_patch_REV2.diff --]
[-- Type: text/plain, Size: 25322 bytes --]

commit 13213642603b4941a2e4ea085b0bfd99995cb37f
Author: Alessandro Fanfarillo <elfanfa@ucar.edu>
Date:   Wed Sep 7 13:00:17 2016 -0600

    Second Review of failed image patch

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index ff5e80b..110bec0 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -1217,6 +1217,82 @@ gfc_check_event_query (gfc_expr *event, gfc_expr *count, gfc_expr *stat)
   return true;
 }
 
+bool
+gfc_check_image_status (gfc_expr *image, gfc_expr *team)
+{
+  if (!type_check (image, 1, BT_INTEGER))
+    return false;
+
+  int i = gfc_validate_kind (BT_INTEGER, image->ts.kind, false);
+  int j = gfc_validate_kind (BT_INTEGER, gfc_default_integer_kind, false);
+
+  if (gfc_integer_kinds[i].range < gfc_integer_kinds[j].range)
+    {
+      gfc_error ("IMAGE argument of the IMAGE_STATUS intrinsic function at %L "
+		 "shall have at least the range of the default integer",
+		 &image->where);
+      return false;
+    }
+
+  j = gfc_validate_kind (BT_INTEGER, gfc_default_integer_kind*2, false);
+
+  if (gfc_integer_kinds[i].range > gfc_integer_kinds[j].range)
+    {
+      gfc_error ("IMAGE argument of the IMAGE_STATUS intrinsic function at %L "
+		 "shall have at most the range of the double precision integer",
+		 &image->where);
+      return false;
+    }
+
+  if (team)
+    {
+      gfc_error ("TEAM argument of the IMAGE_STATUS intrinsic function at %L "
+		 "not yet supported",
+		 &team->where);
+      return false;
+    }
+
+  return true;
+}
+
+bool
+gfc_check_failed_images (gfc_expr *team, gfc_expr *kind)
+{
+  if (team)
+    {
+      gfc_error ("TEAM argument of the FAILED_IMAGES intrinsic function "
+		 "at %L not yet supported", &team->where);
+      return false;
+    }
+
+  if (kind)
+    {
+      int i = gfc_validate_kind (BT_INTEGER, kind->ts.kind, false);
+      int j = gfc_validate_kind (BT_INTEGER, gfc_default_integer_kind, false);
+
+      if (gfc_integer_kinds[i].range < gfc_integer_kinds[j].range)
+	{
+	  gfc_error ("KIND argument of the FAILED_IMAGES intrinsic function "
+		     "at %L shall have at least the range "
+		     "of the default integer", &kind->where);
+	  return false;
+	}
+
+      j = gfc_validate_kind (BT_INTEGER, gfc_default_integer_kind*2, false);
+
+      if (gfc_integer_kinds[i].range > gfc_integer_kinds[j].range)
+	{
+	  gfc_error ("KIND argument of the FAILED_IMAGES "
+		     "intrinsic function at %L shall have at most the "
+		     "range of the double precision integer",
+		     &kind->where);
+	  return false;
+	}
+    }
+
+  return true;
+}
+
 
 bool
 gfc_check_atomic_fetch_op (gfc_expr *atom, gfc_expr *value, gfc_expr *old,
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 8c24074..e731916 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1636,6 +1636,9 @@ show_code_node (int level, gfc_code *c)
 
       break;
 
+    case EXEC_FAIL_IMAGE:
+      fputs ("FAIL IMAGE ", dumpfile);
+
     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 2acf64c..93bd43a 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -255,7 +255,7 @@ enum gfc_statement
   ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD,
   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
@@ -420,6 +420,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,
@@ -463,6 +464,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,
@@ -2393,7 +2395,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/intrinsic.c b/gcc/fortran/intrinsic.c
index ca28eac..2311548 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -1839,6 +1839,10 @@ 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_images, gfc_simplify_failed_images,
+	     gfc_resolve_failed_images, "team", BT_INTEGER, 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);
 
@@ -2080,6 +2084,10 @@ 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_INTEGER, 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,
diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h
index f228976..ae488e8 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_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 *);
@@ -289,6 +291,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_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 *);
@@ -305,6 +308,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 *);
@@ -467,6 +471,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 *);
@@ -490,6 +495,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 *);
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index ecea1c3..2ea43e7 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -2577,6 +2577,29 @@ gfc_resolve_tanh (gfc_expr *f, gfc_expr *x)
     = gfc_get_string ("__tanh_%c%d", gfc_type_letter (x->ts.type), x->ts.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
+    f->ts.kind = kind->ts.kind;
+  f->value.function.name = failed_images;
+}
+
+void
+gfc_resolve_image_status (gfc_expr *f, gfc_expr *image, 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->ts = image->ts;
+  f->value.function.name = image_status;
+}
 
 void
 gfc_resolve_image_index (gfc_expr *f, gfc_expr *array ATTRIBUTE_UNUSED,
diff --git a/gcc/fortran/libgfortran.h b/gcc/fortran/libgfortran.h
index e913250..f00ed83 100644
--- a/gcc/fortran/libgfortran.h
+++ b/gcc/fortran/libgfortran.h
@@ -123,7 +123,7 @@ typedef enum
   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 9056cb7..8916767 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -1600,6 +1600,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)
@@ -3079,6 +3080,34 @@ gfc_match_event_wait (void)
   return event_statement (ST_EVENT_WAIT);
 }
 
+/* Match a FAIL IMAGE statement.  */
+
+static match
+fail_image_statement (gfc_statement st)
+{
+  if (gfc_match_char ('(') == MATCH_YES)
+    goto syntax;
+
+  gcc_assert (st == ST_FAIL_IMAGE);
+
+  new_st.op = EXEC_FAIL_IMAGE;
+
+  return MATCH_YES;
+
+ syntax:
+  gfc_syntax_error (st);
+
+  return MATCH_ERROR;
+}
+
+match
+gfc_match_fail_image (void)
+{
+  if (!gfc_notify_std (GFC_STD_F2008_TS, "FAIL IMAGE statement at %C"))
+    return MATCH_ERROR;
+
+  return fail_image_statement (ST_FAIL_IMAGE);
+}
 
 /* Match LOCK/UNLOCK statement. Syntax:
      LOCK ( lock-variable [ , lock-stat-list ] )
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index 348ca70..4e4b833 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -72,6 +72,7 @@ match gfc_match_else (void);
 match gfc_match_elseif (void);
 match gfc_match_event_post (void);
 match gfc_match_event_wait (void);
+match gfc_match_fail_image (void);
 match gfc_match_critical (void);
 match gfc_match_block (void);
 match gfc_match_associate (void);
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 86f2c42..c0ed68f 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -483,6 +483,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);
@@ -1419,7 +1420,7 @@ next_statement (void)
   case ST_OMP_CANCEL: case ST_OMP_CANCELLATION_POINT: \
   case ST_OMP_TARGET_UPDATE: 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
 
@@ -1745,6 +1746,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 f8ba00b..42cbb9f 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -8837,6 +8837,17 @@ find_reachable_labels (gfc_code *block)
     }
 }
 
+static void
+resolve_fail_image (gfc_code *code ATTRIBUTE_UNUSED)
+{
+  if (flag_coarray == GFC_FCOARRAY_SINGLE)
+    {
+      //call exit
+      ;
+    }
+
+  return;
+}
 
 static void
 resolve_lock_unlock_event (gfc_code *code)
@@ -10583,6 +10594,10 @@ start:
 	  resolve_lock_unlock_event (code);
 	  break;
 
+	case EXEC_FAIL_IMAGE:
+	  resolve_fail_image (code);
+	  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 c396653..92d0006 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -2312,6 +2312,16 @@ gfc_simplify_exponent (gfc_expr *x)
   return range_check (result, "EXPONENT");
 }
 
+gfc_expr *
+gfc_simplify_failed_images(gfc_expr *team ATTRIBUTE_UNUSED, gfc_expr *kind)
+{
+  if (flag_coarray != GFC_FCOARRAY_SINGLE)
+    return NULL;
+
+  gfc_expr *result;
+  result = transformational_result (result, 0, BT_INTEGER, kind->ts.kind, &gfc_current_locus);
+  return result;
+}
 
 gfc_expr *
 gfc_simplify_float (gfc_expr *a)
@@ -6578,6 +6588,19 @@ gfc_simplify_image_index (gfc_expr *coarray, gfc_expr *sub)
   return result;
 }
 
+gfc_expr *
+gfc_simplify_image_status(gfc_expr *image ATTRIBUTE_UNUSED, gfc_expr *team ATTRIBUTE_UNUSED)
+{
+  if (flag_coarray != GFC_FCOARRAY_SINGLE)
+    return NULL;
+
+  gfc_expr *result;
+  /* FIXME: gfc_current_locus is wrong.  */
+  result = gfc_get_constant_expr (BT_INTEGER, gfc_default_integer_kind,
+				  &gfc_current_locus);
+  mpz_set_si (result->value.integer, 0);
+  return result;
+}
 
 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 7395497..b3a6721 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 5bae8ca..5c40005 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -151,6 +151,9 @@ 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_co_broadcast;
 tree gfor_fndecl_co_max;
 tree gfor_fndecl_co_min;
@@ -3671,6 +3674,18 @@ 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_with_spec (
+        get_identifier (PREFIX("caf_fail_image")), "R",
+      	void_type_node, 1, pvoid_type_node);
+
+      gfor_fndecl_caf_failed_images = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("caf_failed_images")), "WRR",
+	pvoid_type_node, 3, pvoid_type_node, integer_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, 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 19239fb..f1ed808 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -6146,10 +6146,11 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
          components must have the result allocatable components copied.  */
       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 8167842..cd4486b 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -1677,6 +1677,19 @@ trans_this_image (gfc_se * se, gfc_expr *expr)
 					       m, lbound));
 }
 
+static void
+gfc_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);
+  tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_image_status, 2,
+			     args[0], build_int_cst (integer_type_node, -1));
+  se->expr = tmp;
+}
 
 static void
 trans_image_index (gfc_se * se, gfc_expr *expr)
@@ -8333,6 +8346,10 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
       trans_image_index (se, expr);
       break;
 
+    case GFC_ISYM_IMAGE_STATUS:
+      gfc_conv_intrinsic_image_status (se, expr);
+      break;
+
     case GFC_ISYM_NUM_IMAGES:
       trans_num_images (se, expr);
       break;
@@ -8683,10 +8700,11 @@ 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_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 5884e7a..aefe1a8 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -674,6 +674,32 @@ gfc_trans_stop (gfc_code *code, bool error_stop)
   return gfc_finish_block (&se.pre);
 }
 
+/* Translate the FAIL IMAGE statement.  We have to translate this statement
+   to a runtime library call.  */
+
+tree
+gfc_trans_fail_image (gfc_code *code ATTRIBUTE_UNUSED)
+{
+  gfc_se se;
+  tree tmp;
+
+  /* Start a new block for this statement.  */
+  gfc_init_se (&se, NULL);
+  gfc_start_block (&se.pre);
+
+  if (flag_coarray == GFC_FCOARRAY_LIB)
+    tmp = build_call_expr_loc (input_location,
+			       gfor_fndecl_caf_fail_image, 1,
+			       build_int_cst (pchar_type_node, 0));
+  else
+    tmp = build_call_expr_loc (input_location,
+			       gfor_fndecl_stop_string, 1,
+			       build_int_cst (pchar_type_node, 1));
+
+  gfc_add_expr_to_block (&se.pre, tmp);
+  gfc_add_block_to_block (&se.pre, &se.post);
+  return gfc_finish_block (&se.pre);
+}
 
 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 f9c8e74..4b5b4fc 100644
--- a/gcc/fortran/trans-stmt.h
+++ b/gcc/fortran/trans-stmt.h
@@ -56,6 +56,7 @@ tree gfc_trans_select (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 28d1341..1f5d7f3 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -1826,6 +1826,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 512615a..c6b142f 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -776,6 +776,9 @@ 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_co_broadcast;
 extern GTY(()) tree gfor_fndecl_co_max;
 extern GTY(()) tree gfor_fndecl_co_min;
diff --git a/gcc/testsuite/gfortran.dg/coarray_fail_st.f90 b/gcc/testsuite/gfortran.dg/coarray_fail_st.f90
new file mode 100644
index 0000000..d4eb8e2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_fail_st.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original -fcoarray=lib" }
+!
+program fail_statement
+  implicit none
+
+  integer :: me,np,stat
+
+  me = this_image()
+  np = num_images()
+  stat = 0
+
+  if(me == 1) fail image
+
+  sync all(stat=stat)
+
+  if(stat /= 0) write(*,*) 'Image failed during sync'
+
+end program fail_statement
+
+! { dg-final { scan-tree-dump-times "_gfortran_caf_fail_image \\\(0B\\\);" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/coarray_failed_images.f90 b/gcc/testsuite/gfortran.dg/coarray_failed_images.f90
new file mode 100644
index 0000000..b64ed25
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_failed_images.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original -fcoarray=lib" }
+!
+program test_failed_images
+  implicit none
+
+  integer :: me,np,stat
+  character(len=1) :: c
+
+  me = this_image()
+  np = num_images()
+  stat = 0
+
+  sync all(stat=stat)
+
+  if(stat /= 0) then
+     write(*,*) failed_images()
+  endif
+end program test_failed_images
+
+! { dg-final { scan-tree-dump-times "_gfortran_caf_failed_images \\\(&atmp.1, 0B, 0B\\\);" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/coarray_failed_images_err.f90 b/gcc/testsuite/gfortran.dg/coarray_failed_images_err.f90
new file mode 100644
index 0000000..c3b1a79
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_failed_images_err.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=lib" }
+!
+program test_failed_images_err
+  implicit none
+
+  integer :: me,np,stat
+  character(len=1) :: c
+
+  me = this_image()
+  np = num_images()
+  stat = 0
+
+  sync all(stat=stat)
+
+  if(stat /= 0) then
+     write(*,*) failed_images(me) ! { dg-error "TEAM argument of the FAILED_IMAGES intrinsic function at .1. not yet supported" }
+  endif
+end program test_failed_images_err
diff --git a/gcc/testsuite/gfortran.dg/coarray_image_status.f90 b/gcc/testsuite/gfortran.dg/coarray_image_status.f90
new file mode 100644
index 0000000..9145da7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_image_status.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original -fcoarray=lib" }
+!
+program test_image_status
+  implicit none
+
+  integer :: me,np,stat
+  character(len=1) :: c
+
+  me = this_image()
+  np = num_images()
+  stat = 0
+
+  sync all(stat=stat)
+
+  if(stat /= 0) then
+     write(*,*) image_status(1)
+  endif
+end program test_image_status
+
+! { dg-final { scan-tree-dump-times "_gfortran_caf_image_status \\\(1, -1\\\);" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/coarray_image_status_err.f90 b/gcc/testsuite/gfortran.dg/coarray_image_status_err.f90
new file mode 100644
index 0000000..bf36f59
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_image_status_err.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=lib" }
+!
+program test_image_status_err
+  implicit none
+
+  integer :: me,np,stat
+  character(len=1) :: c
+
+  me = this_image()
+  np = num_images()
+  stat = 0
+
+  sync all(stat=stat)
+
+  if(stat /= 0) then
+     write(*,*) image_status(1,team=1) ! { dg-error "TEAM argument of the IMAGE_STATUS intrinsic function at .1. not yet supported" }
+  endif
+end program test_image_status_err

Re: [Fortran, Patch] First patch for coarray FAILED IMAGES (TS 18508)

[Andre Vehreschild]

Hi Alessandro,

there are still some violations of the style guide:

contrib/check_GNU_style.sh first_complete_patch_REV2.diff

emits:

Lines should not exceed 80 characters.
154:+  add_sym_2 ("failed_images", GFC_ISYM_FAILED_IMAGES,
CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, 155:+             dd,
GFC_STD_F2008_TS, gfc_check_failed_images, gfc_simplify_failed_images,
156:+             gfc_resolve_failed_images, "team", BT_INTEGER, di, OPTIONAL,
"kind", BT_INTEGER, di, OPTIONAL); 165:+  add_sym_2 ("image_status",
GFC_ISYM_IMAGE_STATUS, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER,
166:+             di, GFC_STD_F2008_TS, gfc_check_image_status,
gfc_simplify_image_status, 167:+             gfc_resolve_image_status, "image",
BT_INTEGER, di, REQUIRED, "team", BT_INTEGER, di, OPTIONAL);
247:+gfc_resolve_image_status (gfc_expr *f, gfc_expr *image, gfc_expr *team
ATTRIBUTE_UNUSED) 409:+  result = transformational_result (result, 0,
BT_INTEGER, kind->ts.kind, &gfc_current_locus);
420:+gfc_simplify_image_status(gfc_expr *image ATTRIBUTE_UNUSED, gfc_expr *team
ATTRIBUTE_UNUSED) 469:+      gfor_fndecl_caf_failed_images =
gfc_build_library_function_decl_with_spec ( 471:+        pvoid_type_node, 3,
pvoid_type_node, integer_type_node, integer_type_node); 

<snipp> The remainder of the script output needs no fix, because its in Fortran
code.

You should fix the above, where they are not in a Fortran testcases. This
allows people with 80 column terminals to read the whole line without scrolling.

The if in resolve.c at 8837: resolve_failed_image (... is intentional? It is
doing nothing. So do you plan to add more code, or will there never be
anything. If the later I recommend to just put a comment there and remove the
empty if.

There still is no test when -fcoarray=single is used. This shouldn't be so
hard, should it?

Regards,
	Andre

On Mon, 19 Sep 2016 08:30:12 -0700
Alessandro Fanfarillo <fanfarillo.gcc@gmail.com> wrote:

> * PING *
> 
> On Sep 7, 2016 3:01 PM, "Alessandro Fanfarillo" <fanfarillo.gcc@gmail.com>
> wrote:
> 
> > Dear all,
> > the attached patch supports failed images also when -fcoarray=single is
> > used.
> >
> > Built and regtested on x86_64-pc-linux-gnu.
> >
> > Cheers,
> > Alessandro
> >
> > 2016-08-09 5:22 GMT-06:00 Paul Richard Thomas <
> > paul.richard.thomas@gmail.com>:
> > > Hi Sandro,
> > >
> > > As far as I can see, this is OK barring a couple of minor wrinkles and
> > > a question:
> > >
> > > For coarray_failed_images_err.f90 and coarray_image_status_err.f90 you
> > > have used the option -fdump-tree-original without making use of the
> > > tree dump.
> > >
> > > Mikael asked you to provide an executable test with -fcoarray=single.
> > > Is this not possible for some reason?
> > >
> > > Otherwise, this is OK for trunk.
> > >
> > > Thanks for the patch.
> > >
> > > Paul
> > >
> > > On 4 August 2016 at 05:07, Alessandro Fanfarillo
> > > <fanfarillo.gcc@gmail.com> wrote:
> > >> * PING *
> > >>
> > >> 2016-07-21 13:05 GMT-06:00 Alessandro Fanfarillo <
> > fanfarillo.gcc@gmail.com>:
> > >>> Dear Mikael and all,
> > >>>
> > >>> in attachment the new patch, built and regtested on
> > x86_64-pc-linux-gnu.
> > >>>
> > >>> Cheers,
> > >>> Alessandro
> > >>>
> > >>> 2016-07-20 13:17 GMT-06:00 Mikael Morin <morin-mikael@orange.fr>:
> > >>>> Le 20/07/2016 à 11:39, Andre Vehreschild a écrit :
> > >>>>>
> > >>>>> Hi Mikael,
> > >>>>>
> > >>>>>
> > >>>>>>> +  if(st == ST_FAIL_IMAGE)
> > >>>>>>> +    new_st.op = EXEC_FAIL_IMAGE;
> > >>>>>>> +  else
> > >>>>>>> +    gcc_unreachable();
> > >>>>>>
> > >>>>>> You can use
> > >>>>>>         gcc_assert (st == ST_FAIL_IMAGE);
> > >>>>>>         foo...;
> > >>>>>> instead of
> > >>>>>>         if (st == ST_FAIL_IMAGE)
> > >>>>>>                 foo...;
> > >>>>>>         else
> > >>>>>>                 gcc_unreachable ();
> > >>>>>
> > >>>>>
> > >>>>> Be careful, this is not 100% identical in the general case. For older
> > >>>>> gcc version (gcc < 4008) gcc_assert() is mapped to nothing, esp. not
> > to
> > >>>>> an abort(), so the behavior can change. But in this case everything
> > is
> > >>>>> fine, because the patch is most likely not backported.
> > >>>>>
> > >>>> Didn't know about this. The difference seems to be very subtle.
> > >>>> I don't mind much anyway. The original version can stay if preferred,
> > this
> > >>>> was just a suggestion.
> > >>>>
> > >>>> By the way, if the function is inlined in its single caller, the
> > assert or
> > >>>> unreachable statement can be removed, which avoids choosing between
> > them.
> > >>>> That's another suggestion.
> > >>>>
> > >>>>
> > >>>>>>> +
> > >>>>>>> +  return MATCH_YES;
> > >>>>>>> +
> > >>>>>>> + syntax:
> > >>>>>>> +  gfc_syntax_error (st);
> > >>>>>>> +
> > >>>>>>> +  return MATCH_ERROR;
> > >>>>>>> +}
> > >>>>>>> +
> > >>>>>>> +match
> > >>>>>>> +gfc_match_fail_image (void)
> > >>>>>>> +{
> > >>>>>>> +  /* if (!gfc_notify_std (GFC_STD_F2008_TS, "FAIL IMAGE statement
> > >>>>>>> at %C")) */
> > >>>>>>> +  /*   return MATCH_ERROR; */
> > >>>>>>> +
> > >>>>>>
> > >>>>>> Can this be uncommented?
> > >>>>>>
> > >>>>>>> +  return fail_image_statement (ST_FAIL_IMAGE);
> > >>>>>>> +}
> > >>>>>>>
> > >>>>>>>  /* Match LOCK/UNLOCK statement. Syntax:
> > >>>>>>>       LOCK ( lock-variable [ , lock-stat-list ] )
> > >>>>>>> diff --git a/gcc/fortran/trans-intrinsic.c
> > >>>>>>> b/gcc/fortran/trans-intrinsic.c index 1aaf4e2..b2f5596 100644
> > >>>>>>> --- a/gcc/fortran/trans-intrinsic.c
> > >>>>>>> +++ b/gcc/fortran/trans-intrinsic.c
> > >>>>>>> @@ -1647,6 +1647,24 @@ trans_this_image (gfc_se * se, gfc_expr
> > >>>>>>> *expr) m, lbound));
> > >>>>>>>  }
> > >>>>>>>
> > >>>>>>> +static void
> > >>>>>>> +gfc_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);
> > >>>>>>> +
> > >>>>>>> +  if (flag_coarray == GFC_FCOARRAY_LIB)
> > >>>>>>> +    {
> > >>>>>>
> > >>>>>> Can everything be put under the if?
> > >>>>>> Does it work with -fcoarray=single?
> > >>>>>
> > >>>>>
> > >>>>> IMO coarray=single should not generate code here, therefore putting
> > >>>>> everything under the if should to fine.
> > >>>>>
> > >>>> My point was more avoiding generating code for the arguments if they
> > are not
> > >>>> used in the end.
> > >>>> Regarding the -fcoarray=single case, the function returns a result,
> > which
> > >>>> can be used in an expression, so I don't think it will work without
> > at least
> > >>>> hardcoding a fixed value as result in that case.
> > >>>> But even that wouldn't be enough, as the function wouldn't work
> > consistently
> > >>>> with the fail image statement.
> > >>>>
> > >>>>> Sorry for the comments ...
> > >>>>>
> > >>>> Comments are welcome here, as far as I know. ;-)
> > >>>>
> > >>>> Mikael
> > >
> > >
> > >
> > > --
> > > The difference between genius and stupidity is; genius has its limits.
> > >
> > > Albert Einstein
> >


-- 
Andre Vehreschild * Email: vehre ad gmx dot de 

Re: [Fortran, Patch] First patch for coarray FAILED IMAGES (TS 18508)

[Alessandro Fanfarillo]

[-- Attachment #1: Type: text/plain, Size: 6346 bytes --]

Thanks Andre.

2016-09-19 9:55 GMT-06:00 Andre Vehreschild <vehre@gmx.de>:
> Hi Alessandro,

> The if in resolve.c at 8837: resolve_failed_image (... is intentional? It is
> doing nothing. So do you plan to add more code, or will there never be
> anything. If the later I recommend to just put a comment there and remove the
> empty if.

I added the if statement during the development and I forgot to remove it.

>
> There still is no test when -fcoarray=single is used. This shouldn't be so
> hard, should it?

Done.

Built and regtested on x86_64-pc-linux-gnu.

>
> Regards,
>         Andre
>
> On Mon, 19 Sep 2016 08:30:12 -0700
> Alessandro Fanfarillo <fanfarillo.gcc@gmail.com> wrote:
>
>> * PING *
>>
>> On Sep 7, 2016 3:01 PM, "Alessandro Fanfarillo" <fanfarillo.gcc@gmail.com>
>> wrote:
>>
>> > Dear all,
>> > the attached patch supports failed images also when -fcoarray=single is
>> > used.
>> >
>> > Built and regtested on x86_64-pc-linux-gnu.
>> >
>> > Cheers,
>> > Alessandro
>> >
>> > 2016-08-09 5:22 GMT-06:00 Paul Richard Thomas <
>> > paul.richard.thomas@gmail.com>:
>> > > Hi Sandro,
>> > >
>> > > As far as I can see, this is OK barring a couple of minor wrinkles and
>> > > a question:
>> > >
>> > > For coarray_failed_images_err.f90 and coarray_image_status_err.f90 you
>> > > have used the option -fdump-tree-original without making use of the
>> > > tree dump.
>> > >
>> > > Mikael asked you to provide an executable test with -fcoarray=single.
>> > > Is this not possible for some reason?
>> > >
>> > > Otherwise, this is OK for trunk.
>> > >
>> > > Thanks for the patch.
>> > >
>> > > Paul
>> > >
>> > > On 4 August 2016 at 05:07, Alessandro Fanfarillo
>> > > <fanfarillo.gcc@gmail.com> wrote:
>> > >> * PING *
>> > >>
>> > >> 2016-07-21 13:05 GMT-06:00 Alessandro Fanfarillo <
>> > fanfarillo.gcc@gmail.com>:
>> > >>> Dear Mikael and all,
>> > >>>
>> > >>> in attachment the new patch, built and regtested on
>> > x86_64-pc-linux-gnu.
>> > >>>
>> > >>> Cheers,
>> > >>> Alessandro
>> > >>>
>> > >>> 2016-07-20 13:17 GMT-06:00 Mikael Morin <morin-mikael@orange.fr>:
>> > >>>> Le 20/07/2016 à 11:39, Andre Vehreschild a écrit :
>> > >>>>>
>> > >>>>> Hi Mikael,
>> > >>>>>
>> > >>>>>
>> > >>>>>>> +  if(st == ST_FAIL_IMAGE)
>> > >>>>>>> +    new_st.op = EXEC_FAIL_IMAGE;
>> > >>>>>>> +  else
>> > >>>>>>> +    gcc_unreachable();
>> > >>>>>>
>> > >>>>>> You can use
>> > >>>>>>         gcc_assert (st == ST_FAIL_IMAGE);
>> > >>>>>>         foo...;
>> > >>>>>> instead of
>> > >>>>>>         if (st == ST_FAIL_IMAGE)
>> > >>>>>>                 foo...;
>> > >>>>>>         else
>> > >>>>>>                 gcc_unreachable ();
>> > >>>>>
>> > >>>>>
>> > >>>>> Be careful, this is not 100% identical in the general case. For older
>> > >>>>> gcc version (gcc < 4008) gcc_assert() is mapped to nothing, esp. not
>> > to
>> > >>>>> an abort(), so the behavior can change. But in this case everything
>> > is
>> > >>>>> fine, because the patch is most likely not backported.
>> > >>>>>
>> > >>>> Didn't know about this. The difference seems to be very subtle.
>> > >>>> I don't mind much anyway. The original version can stay if preferred,
>> > this
>> > >>>> was just a suggestion.
>> > >>>>
>> > >>>> By the way, if the function is inlined in its single caller, the
>> > assert or
>> > >>>> unreachable statement can be removed, which avoids choosing between
>> > them.
>> > >>>> That's another suggestion.
>> > >>>>
>> > >>>>
>> > >>>>>>> +
>> > >>>>>>> +  return MATCH_YES;
>> > >>>>>>> +
>> > >>>>>>> + syntax:
>> > >>>>>>> +  gfc_syntax_error (st);
>> > >>>>>>> +
>> > >>>>>>> +  return MATCH_ERROR;
>> > >>>>>>> +}
>> > >>>>>>> +
>> > >>>>>>> +match
>> > >>>>>>> +gfc_match_fail_image (void)
>> > >>>>>>> +{
>> > >>>>>>> +  /* if (!gfc_notify_std (GFC_STD_F2008_TS, "FAIL IMAGE statement
>> > >>>>>>> at %C")) */
>> > >>>>>>> +  /*   return MATCH_ERROR; */
>> > >>>>>>> +
>> > >>>>>>
>> > >>>>>> Can this be uncommented?
>> > >>>>>>
>> > >>>>>>> +  return fail_image_statement (ST_FAIL_IMAGE);
>> > >>>>>>> +}
>> > >>>>>>>
>> > >>>>>>>  /* Match LOCK/UNLOCK statement. Syntax:
>> > >>>>>>>       LOCK ( lock-variable [ , lock-stat-list ] )
>> > >>>>>>> diff --git a/gcc/fortran/trans-intrinsic.c
>> > >>>>>>> b/gcc/fortran/trans-intrinsic.c index 1aaf4e2..b2f5596 100644
>> > >>>>>>> --- a/gcc/fortran/trans-intrinsic.c
>> > >>>>>>> +++ b/gcc/fortran/trans-intrinsic.c
>> > >>>>>>> @@ -1647,6 +1647,24 @@ trans_this_image (gfc_se * se, gfc_expr
>> > >>>>>>> *expr) m, lbound));
>> > >>>>>>>  }
>> > >>>>>>>
>> > >>>>>>> +static void
>> > >>>>>>> +gfc_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);
>> > >>>>>>> +
>> > >>>>>>> +  if (flag_coarray == GFC_FCOARRAY_LIB)
>> > >>>>>>> +    {
>> > >>>>>>
>> > >>>>>> Can everything be put under the if?
>> > >>>>>> Does it work with -fcoarray=single?
>> > >>>>>
>> > >>>>>
>> > >>>>> IMO coarray=single should not generate code here, therefore putting
>> > >>>>> everything under the if should to fine.
>> > >>>>>
>> > >>>> My point was more avoiding generating code for the arguments if they
>> > are not
>> > >>>> used in the end.
>> > >>>> Regarding the -fcoarray=single case, the function returns a result,
>> > which
>> > >>>> can be used in an expression, so I don't think it will work without
>> > at least
>> > >>>> hardcoding a fixed value as result in that case.
>> > >>>> But even that wouldn't be enough, as the function wouldn't work
>> > consistently
>> > >>>> with the fail image statement.
>> > >>>>
>> > >>>>> Sorry for the comments ...
>> > >>>>>
>> > >>>> Comments are welcome here, as far as I know. ;-)
>> > >>>>
>> > >>>> Mikael
>> > >
>> > >
>> > >
>> > > --
>> > > The difference between genius and stupidity is; genius has its limits.
>> > >
>> > > Albert Einstein
>> >
>
>
> --
> Andre Vehreschild * Email: vehre ad gmx dot de

[-- Attachment #2: first_complete_patch_REV3.diff --]
[-- Type: text/x-patch, Size: 28226 bytes --]

commit a5750c4835566687505c34f73562c7cc3b220841
Author: Alessandro Fanfarillo <elfanfa@ucar.edu>
Date:   Wed Sep 21 12:00:50 2016 -0600

    Third review of failed images patch

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index ff5e80b..110bec0 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -1217,6 +1217,82 @@ gfc_check_event_query (gfc_expr *event, gfc_expr *count, gfc_expr *stat)
   return true;
 }
 
+bool
+gfc_check_image_status (gfc_expr *image, gfc_expr *team)
+{
+  if (!type_check (image, 1, BT_INTEGER))
+    return false;
+
+  int i = gfc_validate_kind (BT_INTEGER, image->ts.kind, false);
+  int j = gfc_validate_kind (BT_INTEGER, gfc_default_integer_kind, false);
+
+  if (gfc_integer_kinds[i].range < gfc_integer_kinds[j].range)
+    {
+      gfc_error ("IMAGE argument of the IMAGE_STATUS intrinsic function at %L "
+		 "shall have at least the range of the default integer",
+		 &image->where);
+      return false;
+    }
+
+  j = gfc_validate_kind (BT_INTEGER, gfc_default_integer_kind*2, false);
+
+  if (gfc_integer_kinds[i].range > gfc_integer_kinds[j].range)
+    {
+      gfc_error ("IMAGE argument of the IMAGE_STATUS intrinsic function at %L "
+		 "shall have at most the range of the double precision integer",
+		 &image->where);
+      return false;
+    }
+
+  if (team)
+    {
+      gfc_error ("TEAM argument of the IMAGE_STATUS intrinsic function at %L "
+		 "not yet supported",
+		 &team->where);
+      return false;
+    }
+
+  return true;
+}
+
+bool
+gfc_check_failed_images (gfc_expr *team, gfc_expr *kind)
+{
+  if (team)
+    {
+      gfc_error ("TEAM argument of the FAILED_IMAGES intrinsic function "
+		 "at %L not yet supported", &team->where);
+      return false;
+    }
+
+  if (kind)
+    {
+      int i = gfc_validate_kind (BT_INTEGER, kind->ts.kind, false);
+      int j = gfc_validate_kind (BT_INTEGER, gfc_default_integer_kind, false);
+
+      if (gfc_integer_kinds[i].range < gfc_integer_kinds[j].range)
+	{
+	  gfc_error ("KIND argument of the FAILED_IMAGES intrinsic function "
+		     "at %L shall have at least the range "
+		     "of the default integer", &kind->where);
+	  return false;
+	}
+
+      j = gfc_validate_kind (BT_INTEGER, gfc_default_integer_kind*2, false);
+
+      if (gfc_integer_kinds[i].range > gfc_integer_kinds[j].range)
+	{
+	  gfc_error ("KIND argument of the FAILED_IMAGES "
+		     "intrinsic function at %L shall have at most the "
+		     "range of the double precision integer",
+		     &kind->where);
+	  return false;
+	}
+    }
+
+  return true;
+}
+
 
 bool
 gfc_check_atomic_fetch_op (gfc_expr *atom, gfc_expr *value, gfc_expr *old,
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 8c24074..e731916 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1636,6 +1636,9 @@ show_code_node (int level, gfc_code *c)
 
       break;
 
+    case EXEC_FAIL_IMAGE:
+      fputs ("FAIL IMAGE ", dumpfile);
+
     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 c3fb6ed..c617340 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -255,7 +255,7 @@ enum gfc_statement
   ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD,
   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
@@ -420,6 +420,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,
@@ -463,6 +464,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,
@@ -2395,7 +2397,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/intrinsic.c b/gcc/fortran/intrinsic.c
index cad54b8..ac0dd5e 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -1840,6 +1840,12 @@ 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_images, gfc_simplify_failed_images,
+	     gfc_resolve_failed_images, "team", BT_INTEGER, 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 +2087,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_INTEGER, 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,
diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h
index f228976..ae488e8 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_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 *);
@@ -289,6 +291,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_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 *);
@@ -305,6 +308,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 *);
@@ -467,6 +471,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 *);
@@ -490,6 +495,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 *);
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index ecea1c3..dc05cd3 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -2577,6 +2577,30 @@ gfc_resolve_tanh (gfc_expr *f, gfc_expr *x)
     = gfc_get_string ("__tanh_%c%d", gfc_type_letter (x->ts.type), x->ts.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
+    f->ts.kind = kind->ts.kind;
+  f->value.function.name = failed_images;
+}
+
+void
+gfc_resolve_image_status (gfc_expr *f, gfc_expr *image,
+			  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->ts = image->ts;
+  f->value.function.name = image_status;
+}
 
 void
 gfc_resolve_image_index (gfc_expr *f, gfc_expr *array ATTRIBUTE_UNUSED,
diff --git a/gcc/fortran/libgfortran.h b/gcc/fortran/libgfortran.h
index e913250..f00ed83 100644
--- a/gcc/fortran/libgfortran.h
+++ b/gcc/fortran/libgfortran.h
@@ -123,7 +123,7 @@ typedef enum
   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 9056cb7..8916767 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -1600,6 +1600,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)
@@ -3079,6 +3080,34 @@ gfc_match_event_wait (void)
   return event_statement (ST_EVENT_WAIT);
 }
 
+/* Match a FAIL IMAGE statement.  */
+
+static match
+fail_image_statement (gfc_statement st)
+{
+  if (gfc_match_char ('(') == MATCH_YES)
+    goto syntax;
+
+  gcc_assert (st == ST_FAIL_IMAGE);
+
+  new_st.op = EXEC_FAIL_IMAGE;
+
+  return MATCH_YES;
+
+ syntax:
+  gfc_syntax_error (st);
+
+  return MATCH_ERROR;
+}
+
+match
+gfc_match_fail_image (void)
+{
+  if (!gfc_notify_std (GFC_STD_F2008_TS, "FAIL IMAGE statement at %C"))
+    return MATCH_ERROR;
+
+  return fail_image_statement (ST_FAIL_IMAGE);
+}
 
 /* Match LOCK/UNLOCK statement. Syntax:
      LOCK ( lock-variable [ , lock-stat-list ] )
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index 348ca70..4e4b833 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -72,6 +72,7 @@ match gfc_match_else (void);
 match gfc_match_elseif (void);
 match gfc_match_event_post (void);
 match gfc_match_event_wait (void);
+match gfc_match_fail_image (void);
 match gfc_match_critical (void);
 match gfc_match_block (void);
 match gfc_match_associate (void);
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index d78a2c0..3722075 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -483,6 +483,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);
@@ -1419,7 +1420,7 @@ next_statement (void)
   case ST_OMP_CANCEL: case ST_OMP_CANCELLATION_POINT: \
   case ST_OMP_TARGET_UPDATE: 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
 
@@ -1745,6 +1746,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 11b6a14..57c759a 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -8859,6 +8859,11 @@ find_reachable_labels (gfc_code *block)
     }
 }
 
+static void
+resolve_fail_image (gfc_code *code ATTRIBUTE_UNUSED)
+{
+  return;
+}
 
 static void
 resolve_lock_unlock_event (gfc_code *code)
@@ -10607,6 +10612,10 @@ start:
 	  resolve_lock_unlock_event (code);
 	  break;
 
+	case EXEC_FAIL_IMAGE:
+	  resolve_fail_image (code);
+	  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 ad547a1..5e55f02 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -2312,6 +2312,26 @@ gfc_simplify_exponent (gfc_expr *x)
   return range_check (result, "EXPONENT");
 }
 
+gfc_expr *
+gfc_simplify_failed_images (gfc_expr *team ATTRIBUTE_UNUSED, gfc_expr *kind)
+{
+  gfc_expr *result;
+  int actual_kind;
+
+  if (flag_coarray != GFC_FCOARRAY_SINGLE)
+    return NULL;
+
+  if (!kind)
+    actual_kind = gfc_default_integer_kind;
+  else
+    actual_kind = kind->ts.kind;
+
+  result = transformational_result (result, NULL, BT_INTEGER, actual_kind,
+				    &gfc_current_locus);
+  init_result_expr (result, 0, NULL);
+  result = simplify_transformation (result, NULL, NULL, 0, NULL);
+  return result;
+}
 
 gfc_expr *
 gfc_simplify_float (gfc_expr *a)
@@ -6578,6 +6598,20 @@ gfc_simplify_image_index (gfc_expr *coarray, gfc_expr *sub)
   return result;
 }
 
+gfc_expr *
+gfc_simplify_image_status (gfc_expr *image ATTRIBUTE_UNUSED,
+			   gfc_expr *team ATTRIBUTE_UNUSED)
+{
+  if (flag_coarray != GFC_FCOARRAY_SINGLE)
+    return NULL;
+
+  gfc_expr *result;
+  /* FIXME: gfc_current_locus is wrong.  */
+  result = gfc_get_constant_expr (BT_INTEGER, gfc_default_integer_kind,
+				  &gfc_current_locus);
+  mpz_set_si (result->value.integer, 0);
+  return result;
+}
 
 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 7395497..b3a6721 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 1bab5d5..ed9f89f 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -154,6 +154,9 @@ 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_co_broadcast;
 tree gfor_fndecl_co_max;
 tree gfor_fndecl_co_min;
@@ -3694,6 +3697,18 @@ 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_with_spec (
+	get_identifier (PREFIX("caf_fail_image")), "R",
+      	void_type_node, 1, pvoid_type_node);
+
+      gfor_fndecl_caf_failed_images = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("caf_failed_images")), "WRR", pvoid_type_node,
+	3, pvoid_type_node, integer_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, 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 9fcd6a1..5aadc6c 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -6239,10 +6239,11 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
          components must have the result allocatable components copied.  */
       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 c6883dc..b0b721f 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -2360,6 +2360,19 @@ trans_this_image (gfc_se * se, gfc_expr *expr)
 					       m, lbound));
 }
 
+static void
+gfc_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);
+  tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_image_status, 2,
+			     args[0], build_int_cst (integer_type_node, -1));
+  se->expr = tmp;
+}
 
 static void
 trans_image_index (gfc_se * se, gfc_expr *expr)
@@ -9017,6 +9030,10 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
       trans_image_index (se, expr);
       break;
 
+    case GFC_ISYM_IMAGE_STATUS:
+      gfc_conv_intrinsic_image_status (se, expr);
+      break;
+
     case GFC_ISYM_NUM_IMAGES:
       trans_num_images (se, expr);
       break;
@@ -9367,10 +9384,11 @@ 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_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 9fdacc1..22c37ee 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -674,6 +674,32 @@ gfc_trans_stop (gfc_code *code, bool error_stop)
   return gfc_finish_block (&se.pre);
 }
 
+/* Translate the FAIL IMAGE statement.  We have to translate this statement
+   to a runtime library call.  */
+
+tree
+gfc_trans_fail_image (gfc_code *code ATTRIBUTE_UNUSED)
+{
+  gfc_se se;
+  tree tmp;
+
+  /* Start a new block for this statement.  */
+  gfc_init_se (&se, NULL);
+  gfc_start_block (&se.pre);
+
+  if (flag_coarray == GFC_FCOARRAY_LIB)
+    tmp = build_call_expr_loc (input_location,
+			       gfor_fndecl_caf_fail_image, 1,
+			       build_int_cst (pchar_type_node, 0));
+  else
+    tmp = build_call_expr_loc (input_location,
+			       gfor_fndecl_stop_string, 1,
+			       build_int_cst (pchar_type_node, 1));
+
+  gfc_add_expr_to_block (&se.pre, tmp);
+  gfc_add_block_to_block (&se.pre, &se.post);
+  return gfc_finish_block (&se.pre);
+}
 
 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 f9c8e74..4b5b4fc 100644
--- a/gcc/fortran/trans-stmt.h
+++ b/gcc/fortran/trans-stmt.h
@@ -56,6 +56,7 @@ tree gfc_trans_select (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 9210e0f..827e0bf 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -1858,6 +1858,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 4d3d207..4641ace 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -800,6 +800,9 @@ 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_co_broadcast;
 extern GTY(()) tree gfor_fndecl_co_max;
 extern GTY(()) tree gfor_fndecl_co_min;
diff --git a/gcc/testsuite/gfortran.dg/coarray/fail_st.f90 b/gcc/testsuite/gfortran.dg/coarray/fail_st.f90
new file mode 100644
index 0000000..b6e50e0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/fail_st.f90
@@ -0,0 +1,9 @@
+! { dg-do run }
+! { dg-options "-fcoarray=single" }
+!
+program fail_statement
+  implicit none
+
+  fail image
+
+end program fail_statement
diff --git a/gcc/testsuite/gfortran.dg/coarray/failed_images_single.f90 b/gcc/testsuite/gfortran.dg/coarray/failed_images_single.f90
new file mode 100644
index 0000000..5583fef
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/failed_images_single.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+! { dg-options "-fcoarray=single -lcaf_single" }
+!
+program test_failed_images
+  use iso_fortran_env
+  implicit none
+
+  integer, allocatable :: failed(:)
+
+  failed = failed_images()
+
+  write(*,*) failed,lbound(failed),ubound(failed)
+  write(*,*) failed_images()
+
+end program test_failed_images
diff --git a/gcc/testsuite/gfortran.dg/coarray/image_status_single.f90 b/gcc/testsuite/gfortran.dg/coarray/image_status_single.f90
new file mode 100644
index 0000000..71d58b4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/image_status_single.f90
@@ -0,0 +1,9 @@
+! { dg-do run }
+! { dg-options "-fcoarray=single" }
+!
+program test_image_status
+  implicit none
+
+  write(*,*) image_status(1)
+
+end program test_image_status
diff --git a/gcc/testsuite/gfortran.dg/coarray_fail_st.f90 b/gcc/testsuite/gfortran.dg/coarray_fail_st.f90
new file mode 100644
index 0000000..d4eb8e2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_fail_st.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original -fcoarray=lib" }
+!
+program fail_statement
+  implicit none
+
+  integer :: me,np,stat
+
+  me = this_image()
+  np = num_images()
+  stat = 0
+
+  if(me == 1) fail image
+
+  sync all(stat=stat)
+
+  if(stat /= 0) write(*,*) 'Image failed during sync'
+
+end program fail_statement
+
+! { dg-final { scan-tree-dump-times "_gfortran_caf_fail_image \\\(0B\\\);" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/coarray_failed_images.f90 b/gcc/testsuite/gfortran.dg/coarray_failed_images.f90
new file mode 100644
index 0000000..b64ed25
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_failed_images.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original -fcoarray=lib" }
+!
+program test_failed_images
+  implicit none
+
+  integer :: me,np,stat
+  character(len=1) :: c
+
+  me = this_image()
+  np = num_images()
+  stat = 0
+
+  sync all(stat=stat)
+
+  if(stat /= 0) then
+     write(*,*) failed_images()
+  endif
+end program test_failed_images
+
+! { dg-final { scan-tree-dump-times "_gfortran_caf_failed_images \\\(&atmp.1, 0B, 0B\\\);" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/coarray_failed_images_err.f90 b/gcc/testsuite/gfortran.dg/coarray_failed_images_err.f90
new file mode 100644
index 0000000..c3b1a79
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_failed_images_err.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=lib" }
+!
+program test_failed_images_err
+  implicit none
+
+  integer :: me,np,stat
+  character(len=1) :: c
+
+  me = this_image()
+  np = num_images()
+  stat = 0
+
+  sync all(stat=stat)
+
+  if(stat /= 0) then
+     write(*,*) failed_images(me) ! { dg-error "TEAM argument of the FAILED_IMAGES intrinsic function at .1. not yet supported" }
+  endif
+end program test_failed_images_err
diff --git a/gcc/testsuite/gfortran.dg/coarray_image_status.f90 b/gcc/testsuite/gfortran.dg/coarray_image_status.f90
new file mode 100644
index 0000000..9145da7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_image_status.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original -fcoarray=lib" }
+!
+program test_image_status
+  implicit none
+
+  integer :: me,np,stat
+  character(len=1) :: c
+
+  me = this_image()
+  np = num_images()
+  stat = 0
+
+  sync all(stat=stat)
+
+  if(stat /= 0) then
+     write(*,*) image_status(1)
+  endif
+end program test_image_status
+
+! { dg-final { scan-tree-dump-times "_gfortran_caf_image_status \\\(1, -1\\\);" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/coarray_image_status_err.f90 b/gcc/testsuite/gfortran.dg/coarray_image_status_err.f90
new file mode 100644
index 0000000..bf36f59
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_image_status_err.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=lib" }
+!
+program test_image_status_err
+  implicit none
+
+  integer :: me,np,stat
+  character(len=1) :: c
+
+  me = this_image()
+  np = num_images()
+  stat = 0
+
+  sync all(stat=stat)
+
+  if(stat /= 0) then
+     write(*,*) image_status(1,team=1) ! { dg-error "TEAM argument of the IMAGE_STATUS intrinsic function at .1. not yet supported" }
+  endif
+end program test_image_status_err
diff --git a/libgfortran/caf/libcaf.h b/libgfortran/caf/libcaf.h
index aad0f62..8e10ba6 100644
--- a/libgfortran/caf/libcaf.h
+++ b/libgfortran/caf/libcaf.h
@@ -231,5 +231,7 @@ void _gfortran_caf_unlock (caf_token_t, size_t, int, int *, char *, int);
 void _gfortran_caf_event_post (caf_token_t, size_t, int, int *, char *, int);
 void _gfortran_caf_event_wait (caf_token_t, size_t, int, int *, char *, int);
 void _gfortran_caf_event_query (caf_token_t, size_t, int, int *, int *);
-
+void _gfortran_caf_failed_images(gfc_descriptor_t *,
+				 int __attribute__ ((unused)),
+				 int __attribute__ ((unused)));
 #endif  /* LIBCAF_H  */
diff --git a/libgfortran/caf/single.c b/libgfortran/caf/single.c
index c472446..72e4672 100644
--- a/libgfortran/caf/single.c
+++ b/libgfortran/caf/single.c
@@ -2877,3 +2877,17 @@ _gfortran_caf_unlock (caf_token_t token, size_t index,
     }
   _gfortran_caf_error_stop_str (msg, (int32_t) strlen (msg));
 }
+
+void
+_gfortran_caf_failed_images(gfc_descriptor_t *array,
+			    int team __attribute__ ((unused)),
+			    int kind __attribute__ ((unused)))
+{
+  int *mem = (int *)calloc(1,sizeof(int));
+  array->base_addr = mem;
+  array->dtype = 265;
+  array->dim[0].lower_bound = 0;
+  array->dim[0]._ubound = -1;
+  array->dim[0]._stride = 1;
+  array->offset = -1;
+}

Re: [Fortran, Patch] First patch for coarray FAILED IMAGES (TS 18508)

[Alessandro Fanfarillo]

* PING *

2016-09-21 19:03 GMT+01:00 Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>:
> Thanks Andre.
>
> 2016-09-19 9:55 GMT-06:00 Andre Vehreschild <vehre@gmx.de>:
>> Hi Alessandro,
>
>> The if in resolve.c at 8837: resolve_failed_image (... is intentional? It is
>> doing nothing. So do you plan to add more code, or will there never be
>> anything. If the later I recommend to just put a comment there and remove the
>> empty if.
>
> I added the if statement during the development and I forgot to remove it.
>
>>
>> There still is no test when -fcoarray=single is used. This shouldn't be so
>> hard, should it?
>
> Done.
>
> Built and regtested on x86_64-pc-linux-gnu.
>
>>
>> Regards,
>>         Andre
>>
>> On Mon, 19 Sep 2016 08:30:12 -0700
>> Alessandro Fanfarillo <fanfarillo.gcc@gmail.com> wrote:
>>
>>> * PING *
>>>
>>> On Sep 7, 2016 3:01 PM, "Alessandro Fanfarillo" <fanfarillo.gcc@gmail.com>
>>> wrote:
>>>
>>> > Dear all,
>>> > the attached patch supports failed images also when -fcoarray=single is
>>> > used.
>>> >
>>> > Built and regtested on x86_64-pc-linux-gnu.
>>> >
>>> > Cheers,
>>> > Alessandro
>>> >
>>> > 2016-08-09 5:22 GMT-06:00 Paul Richard Thomas <
>>> > paul.richard.thomas@gmail.com>:
>>> > > Hi Sandro,
>>> > >
>>> > > As far as I can see, this is OK barring a couple of minor wrinkles and
>>> > > a question:
>>> > >
>>> > > For coarray_failed_images_err.f90 and coarray_image_status_err.f90 you
>>> > > have used the option -fdump-tree-original without making use of the
>>> > > tree dump.
>>> > >
>>> > > Mikael asked you to provide an executable test with -fcoarray=single.
>>> > > Is this not possible for some reason?
>>> > >
>>> > > Otherwise, this is OK for trunk.
>>> > >
>>> > > Thanks for the patch.
>>> > >
>>> > > Paul
>>> > >
>>> > > On 4 August 2016 at 05:07, Alessandro Fanfarillo
>>> > > <fanfarillo.gcc@gmail.com> wrote:
>>> > >> * PING *
>>> > >>
>>> > >> 2016-07-21 13:05 GMT-06:00 Alessandro Fanfarillo <
>>> > fanfarillo.gcc@gmail.com>:
>>> > >>> Dear Mikael and all,
>>> > >>>
>>> > >>> in attachment the new patch, built and regtested on
>>> > x86_64-pc-linux-gnu.
>>> > >>>
>>> > >>> Cheers,
>>> > >>> Alessandro
>>> > >>>
>>> > >>> 2016-07-20 13:17 GMT-06:00 Mikael Morin <morin-mikael@orange.fr>:
>>> > >>>> Le 20/07/2016 à 11:39, Andre Vehreschild a écrit :
>>> > >>>>>
>>> > >>>>> Hi Mikael,
>>> > >>>>>
>>> > >>>>>
>>> > >>>>>>> +  if(st == ST_FAIL_IMAGE)
>>> > >>>>>>> +    new_st.op = EXEC_FAIL_IMAGE;
>>> > >>>>>>> +  else
>>> > >>>>>>> +    gcc_unreachable();
>>> > >>>>>>
>>> > >>>>>> You can use
>>> > >>>>>>         gcc_assert (st == ST_FAIL_IMAGE);
>>> > >>>>>>         foo...;
>>> > >>>>>> instead of
>>> > >>>>>>         if (st == ST_FAIL_IMAGE)
>>> > >>>>>>                 foo...;
>>> > >>>>>>         else
>>> > >>>>>>                 gcc_unreachable ();
>>> > >>>>>
>>> > >>>>>
>>> > >>>>> Be careful, this is not 100% identical in the general case. For older
>>> > >>>>> gcc version (gcc < 4008) gcc_assert() is mapped to nothing, esp. not
>>> > to
>>> > >>>>> an abort(), so the behavior can change. But in this case everything
>>> > is
>>> > >>>>> fine, because the patch is most likely not backported.
>>> > >>>>>
>>> > >>>> Didn't know about this. The difference seems to be very subtle.
>>> > >>>> I don't mind much anyway. The original version can stay if preferred,
>>> > this
>>> > >>>> was just a suggestion.
>>> > >>>>
>>> > >>>> By the way, if the function is inlined in its single caller, the
>>> > assert or
>>> > >>>> unreachable statement can be removed, which avoids choosing between
>>> > them.
>>> > >>>> That's another suggestion.
>>> > >>>>
>>> > >>>>
>>> > >>>>>>> +
>>> > >>>>>>> +  return MATCH_YES;
>>> > >>>>>>> +
>>> > >>>>>>> + syntax:
>>> > >>>>>>> +  gfc_syntax_error (st);
>>> > >>>>>>> +
>>> > >>>>>>> +  return MATCH_ERROR;
>>> > >>>>>>> +}
>>> > >>>>>>> +
>>> > >>>>>>> +match
>>> > >>>>>>> +gfc_match_fail_image (void)
>>> > >>>>>>> +{
>>> > >>>>>>> +  /* if (!gfc_notify_std (GFC_STD_F2008_TS, "FAIL IMAGE statement
>>> > >>>>>>> at %C")) */
>>> > >>>>>>> +  /*   return MATCH_ERROR; */
>>> > >>>>>>> +
>>> > >>>>>>
>>> > >>>>>> Can this be uncommented?
>>> > >>>>>>
>>> > >>>>>>> +  return fail_image_statement (ST_FAIL_IMAGE);
>>> > >>>>>>> +}
>>> > >>>>>>>
>>> > >>>>>>>  /* Match LOCK/UNLOCK statement. Syntax:
>>> > >>>>>>>       LOCK ( lock-variable [ , lock-stat-list ] )
>>> > >>>>>>> diff --git a/gcc/fortran/trans-intrinsic.c
>>> > >>>>>>> b/gcc/fortran/trans-intrinsic.c index 1aaf4e2..b2f5596 100644
>>> > >>>>>>> --- a/gcc/fortran/trans-intrinsic.c
>>> > >>>>>>> +++ b/gcc/fortran/trans-intrinsic.c
>>> > >>>>>>> @@ -1647,6 +1647,24 @@ trans_this_image (gfc_se * se, gfc_expr
>>> > >>>>>>> *expr) m, lbound));
>>> > >>>>>>>  }
>>> > >>>>>>>
>>> > >>>>>>> +static void
>>> > >>>>>>> +gfc_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);
>>> > >>>>>>> +
>>> > >>>>>>> +  if (flag_coarray == GFC_FCOARRAY_LIB)
>>> > >>>>>>> +    {
>>> > >>>>>>
>>> > >>>>>> Can everything be put under the if?
>>> > >>>>>> Does it work with -fcoarray=single?
>>> > >>>>>
>>> > >>>>>
>>> > >>>>> IMO coarray=single should not generate code here, therefore putting
>>> > >>>>> everything under the if should to fine.
>>> > >>>>>
>>> > >>>> My point was more avoiding generating code for the arguments if they
>>> > are not
>>> > >>>> used in the end.
>>> > >>>> Regarding the -fcoarray=single case, the function returns a result,
>>> > which
>>> > >>>> can be used in an expression, so I don't think it will work without
>>> > at least
>>> > >>>> hardcoding a fixed value as result in that case.
>>> > >>>> But even that wouldn't be enough, as the function wouldn't work
>>> > consistently
>>> > >>>> with the fail image statement.
>>> > >>>>
>>> > >>>>> Sorry for the comments ...
>>> > >>>>>
>>> > >>>> Comments are welcome here, as far as I know. ;-)
>>> > >>>>
>>> > >>>> Mikael
>>> > >
>>> > >
>>> > >
>>> > > --
>>> > > The difference between genius and stupidity is; genius has its limits.
>>> > >
>>> > > Albert Einstein
>>> >
>>
>>
>> --
>> Andre Vehreschild * Email: vehre ad gmx dot de

Re: [Fortran, Patch] First patch for coarray FAILED IMAGES (TS 18508)

[Dan Nagle]

Hi,

The failed images features of gfortran are exciting,
and folks here would like to start testing with their scientific codes.
I’d like to build a new gfortran to support them,
but I must build from a trusted source,
which means from trunk, without custom patches.

Can Alessandro’s patch get a review?

Many thanks!

> On Jun 21, 2016, at 10:59, Alessandro Fanfarillo <fanfarillo.gcc@gmail.com> wrote:
> 
> * PING *
> 
> 2016-06-06 15:05 GMT-06:00 Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>:
>> Dear all,
>> 
>> please find in attachment the first patch (of n) for the FAILED IMAGES
>> capability defined in the coarray TS 18508.
>> The patch adds support for three new intrinsic functions defined in
>> the TS for simulating a failure (fail image), checking an image status
>> (image_status) and getting the list of failed images (failed_images).
>> The patch has been built and regtested on x86_64-pc-linux-gnu.
>> 
>> Ok for trunk?
>> 
>> Alessandro


--

Cheers!
Dan Nagle

Re: [Fortran, Patch] First patch for coarray FAILED IMAGES (TS 18508)

[Damian Rouson]

Resending as plain text:

*PING*

With the 7.1.0 deadline approaching tomorrow, is there any chance of getting Alessandro’s FAILED IMAGES patch approved for trunk?  As far as I know, Fortran is the first internationally standardized language to incorporate intrinsic support for fault tolerance, which is believed to be essential to reaching exaflop performance.  As far as I know, gfortran is the first compiler to implement this Fortran 2015 feature.  This is a huge deal and I’m hoping Alessandro and I will be able to report that this is a released feature in a talk we’re giving jointly in early February.  Any assistance would be greatly appreciated.

Damian

> Begin forwarded message:
> 
> 
> From: Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>
> Subject: Re: [Fortran, Patch] First patch for coarray FAILED IMAGES (TS 18508)
> Date: September 21, 2016 at 11:03:48 AM PDT
> To: Andre Vehreschild <vehre@gmx.de>
> Cc: Paul Richard Thomas <paul.richard.thomas@gmail.com>, gfortran <fortran@gcc.gnu.org>, gcc-patches <gcc-patches@gcc.gnu.org>, Mikael Morin <morin-mikael@orange.fr>, Tobias Burnus <burnus@net-b.de>
> 
> 
> Thanks Andre.
> 
> 2016-09-19 9:55 GMT-06:00 Andre Vehreschild <vehre@gmx.de>:
>> Hi Alessandro,
> 
>> The if in resolve.c at 8837: resolve_failed_image (... is intentional? It is
>> doing nothing. So do you plan to add more code, or will there never be
>> anything. If the later I recommend to just put a comment there and remove the
>> empty if.
> 
> I added the if statement during the development and I forgot to remove it.
> 
>> 
>> There still is no test when -fcoarray=single is used. This shouldn't be so
>> hard, should it?
> 
> Done.
> 
> Built and regtested on x86_64-pc-linux-gnu.
> 
>> 
>> Regards,
>>        Andre
>> 
>> On Mon, 19 Sep 2016 08:30:12 -0700
>> Alessandro Fanfarillo <fanfarillo.gcc@gmail.com> wrote:
>> 
>>> * PING *
>>> 
>>> On Sep 7, 2016 3:01 PM, "Alessandro Fanfarillo" <fanfarillo.gcc@gmail.com>
>>> wrote:
>>> 
>>>> Dear all,
>>>> the attached patch supports failed images also when -fcoarray=single is
>>>> used.
>>>> 
>>>> Built and regtested on x86_64-pc-linux-gnu.
>>>> 
>>>> Cheers,
>>>> Alessandro
>>>> 
>>>> 2016-08-09 5:22 GMT-06:00 Paul Richard Thomas <
>>>> paul.richard.thomas@gmail.com>:
>>>>> Hi Sandro,
>>>>> 
>>>>> As far as I can see, this is OK barring a couple of minor wrinkles and
>>>>> a question:
>>>>> 
>>>>> For coarray_failed_images_err.f90 and coarray_image_status_err.f90 you
>>>>> have used the option -fdump-tree-original without making use of the
>>>>> tree dump.
>>>>> 
>>>>> Mikael asked you to provide an executable test with -fcoarray=single.
>>>>> Is this not possible for some reason?
>>>>> 
>>>>> Otherwise, this is OK for trunk.
>>>>> 
>>>>> Thanks for the patch.
>>>>> 
>>>>> Paul
>>>>> 
>>>>> On 4 August 2016 at 05:07, Alessandro Fanfarillo
>>>>> <fanfarillo.gcc@gmail.com> wrote:
>>>>>> * PING *
>>>>>> 
>>>>>> 2016-07-21 13:05 GMT-06:00 Alessandro Fanfarillo <
>>>> fanfarillo.gcc@gmail.com>:
>>>>>>> Dear Mikael and all,
>>>>>>> 
>>>>>>> in attachment the new patch, built and regtested on
>>>> x86_64-pc-linux-gnu.
>>>>>>> 
>>>>>>> Cheers,
>>>>>>> Alessandro
>>>>>>> 
>>>>>>> 2016-07-20 13:17 GMT-06:00 Mikael Morin <morin-mikael@orange.fr>:
>>>>>>>> Le 20/07/2016 à 11:39, Andre Vehreschild a écrit :
>>>>>>>>> 
>>>>>>>>> Hi Mikael,
>>>>>>>>> 
>>>>>>>>> 
>>>>>>>>>>> +  if(st == ST_FAIL_IMAGE)
>>>>>>>>>>> +    new_st.op = EXEC_FAIL_IMAGE;
>>>>>>>>>>> +  else
>>>>>>>>>>> +    gcc_unreachable();
>>>>>>>>>> 
>>>>>>>>>> You can use
>>>>>>>>>>        gcc_assert (st == ST_FAIL_IMAGE);
>>>>>>>>>>        foo...;
>>>>>>>>>> instead of
>>>>>>>>>>        if (st == ST_FAIL_IMAGE)
>>>>>>>>>>                foo...;
>>>>>>>>>>        else
>>>>>>>>>>                gcc_unreachable ();
>>>>>>>>> 
>>>>>>>>> 
>>>>>>>>> Be careful, this is not 100% identical in the general case. For older
>>>>>>>>> gcc version (gcc < 4008) gcc_assert() is mapped to nothing, esp. not
>>>> to
>>>>>>>>> an abort(), so the behavior can change. But in this case everything
>>>> is
>>>>>>>>> fine, because the patch is most likely not backported.
>>>>>>>>> 
>>>>>>>> Didn't know about this. The difference seems to be very subtle.
>>>>>>>> I don't mind much anyway. The original version can stay if preferred,
>>>> this
>>>>>>>> was just a suggestion.
>>>>>>>> 
>>>>>>>> By the way, if the function is inlined in its single caller, the
>>>> assert or
>>>>>>>> unreachable statement can be removed, which avoids choosing between
>>>> them.
>>>>>>>> That's another suggestion.
>>>>>>>> 
>>>>>>>> 
>>>>>>>>>>> +
>>>>>>>>>>> +  return MATCH_YES;
>>>>>>>>>>> +
>>>>>>>>>>> + syntax:
>>>>>>>>>>> +  gfc_syntax_error (st);
>>>>>>>>>>> +
>>>>>>>>>>> +  return MATCH_ERROR;
>>>>>>>>>>> +}
>>>>>>>>>>> +
>>>>>>>>>>> +match
>>>>>>>>>>> +gfc_match_fail_image (void)
>>>>>>>>>>> +{
>>>>>>>>>>> +  /* if (!gfc_notify_std (GFC_STD_F2008_TS, "FAIL IMAGE statement
>>>>>>>>>>> at %C")) */
>>>>>>>>>>> +  /*   return MATCH_ERROR; */
>>>>>>>>>>> +
>>>>>>>>>> 
>>>>>>>>>> Can this be uncommented?
>>>>>>>>>> 
>>>>>>>>>>> +  return fail_image_statement (ST_FAIL_IMAGE);
>>>>>>>>>>> +}
>>>>>>>>>>> 
>>>>>>>>>>> /* Match LOCK/UNLOCK statement. Syntax:
>>>>>>>>>>>      LOCK ( lock-variable [ , lock-stat-list ] )
>>>>>>>>>>> diff --git a/gcc/fortran/trans-intrinsic.c
>>>>>>>>>>> b/gcc/fortran/trans-intrinsic.c index 1aaf4e2..b2f5596 100644
>>>>>>>>>>> --- a/gcc/fortran/trans-intrinsic.c
>>>>>>>>>>> +++ b/gcc/fortran/trans-intrinsic.c
>>>>>>>>>>> @@ -1647,6 +1647,24 @@ trans_this_image (gfc_se * se, gfc_expr
>>>>>>>>>>> *expr) m, lbound));
>>>>>>>>>>> }
>>>>>>>>>>> 
>>>>>>>>>>> +static void
>>>>>>>>>>> +gfc_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);
>>>>>>>>>>> +
>>>>>>>>>>> +  if (flag_coarray == GFC_FCOARRAY_LIB)
>>>>>>>>>>> +    {
>>>>>>>>>> 
>>>>>>>>>> Can everything be put under the if?
>>>>>>>>>> Does it work with -fcoarray=single?
>>>>>>>>> 
>>>>>>>>> 
>>>>>>>>> IMO coarray=single should not generate code here, therefore putting
>>>>>>>>> everything under the if should to fine.
>>>>>>>>> 
>>>>>>>> My point was more avoiding generating code for the arguments if they
>>>> are not
>>>>>>>> used in the end.
>>>>>>>> Regarding the -fcoarray=single case, the function returns a result,
>>>> which
>>>>>>>> can be used in an expression, so I don't think it will work without
>>>> at least
>>>>>>>> hardcoding a fixed value as result in that case.
>>>>>>>> But even that wouldn't be enough, as the function wouldn't work
>>>> consistently
>>>>>>>> with the fail image statement.
>>>>>>>> 
>>>>>>>>> Sorry for the comments ...
>>>>>>>>> 
>>>>>>>> Comments are welcome here, as far as I know. ;-)
>>>>>>>> 
>>>>>>>> Mikael
>>>>> 
>>>>> 
>>>>> 
>>>>> --
>>>>> The difference between genius and stupidity is; genius has its limits.
>>>>> 
>>>>> Albert Einstein
>>>> 
>> 
>> 
>> --
>> Andre Vehreschild * Email: vehre ad gmx dot de

Re: [Fortran, Patch] First patch for coarray FAILED IMAGES (TS 18508)

[Andre Vehreschild]

Hi Damian,

the patch you attached showed to be empty in my mail-client. I retrieved it now
from a former mail on the list. It does not apply cleanly anymore.

I can't okay it, after looking at some of the lines. There is a function call
declared, but no library function is declared -> link error. Parsing of the
arguments to FAIL IMAGE looks dubious to me. There are numerous style
violations. The API-documentation has not been updated. 

So no, I will have to work this over before the patch could have a chance to
get accepted. Sorry.

Regards,
	Andre

On Tue, 17 Jan 2017 22:39:06 -0800
Damian Rouson <damian@sourceryinstitute.org> wrote:

> *PING*
> 
> With the 7.1.0 deadline approaching tomorrow, is there any chance of getting
> Alessandro’s FAILED IMAGES patch approved for trunk?  As far as I know,
> Fortran is the first internationally standardized language to incorporate
> intrinsic support for fault tolerance, which is believed to be essential to
> reaching exaflop performance.  As far as I know, gfortran is the first
> compiler to implement this Fortran 2015 feature.  This is a huge deal and I’m
> hoping Alessandro and I will be able to report that this is a released
> feature in a talk we’re giving jointly in early February.  Any assistance
> would be greatly appreciated.
> 
> Damian
> 
> > Begin forwarded message:
> > 
> > 
> > From: Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>
> > Subject: Re: [Fortran, Patch] First patch for coarray FAILED IMAGES (TS
> > 18508) Date: September 21, 2016 at 11:03:48 AM PDT
> > To: Andre Vehreschild <vehre@gmx.de>
> > Cc: Paul Richard Thomas <paul.richard.thomas@gmail.com>, gfortran
> > <fortran@gcc.gnu.org>, gcc-patches <gcc-patches@gcc.gnu.org>, Mikael Morin
> > <morin-mikael@orange.fr>, Tobias Burnus <burnus@net-b.de>
> > 
> > 
> > Thanks Andre.
> > 
> > 2016-09-19 9:55 GMT-06:00 Andre Vehreschild <vehre@gmx.de>:
> >> Hi Alessandro,
> > 
> >> The if in resolve.c at 8837: resolve_failed_image (... is intentional? It
> >> is doing nothing. So do you plan to add more code, or will there never be
> >> anything. If the later I recommend to just put a comment there and remove
> >> the empty if.
> > 
> > I added the if statement during the development and I forgot to remove it.
> > 
> >> 
> >> There still is no test when -fcoarray=single is used. This shouldn't be so
> >> hard, should it?
> > 
> > Done.
> > 
> > Built and regtested on x86_64-pc-linux-gnu.
> > 
> >> 
> >> Regards,
> >>        Andre
> >> 
> >> On Mon, 19 Sep 2016 08:30:12 -0700
> >> Alessandro Fanfarillo <fanfarillo.gcc@gmail.com> wrote:
> >> 
> >>> * PING *
> >>> 
> >>> On Sep 7, 2016 3:01 PM, "Alessandro Fanfarillo" <fanfarillo.gcc@gmail.com>
> >>> wrote:
> >>> 
> >>>> Dear all,
> >>>> the attached patch supports failed images also when -fcoarray=single is
> >>>> used.
> >>>> 
> >>>> Built and regtested on x86_64-pc-linux-gnu.
> >>>> 
> >>>> Cheers,
> >>>> Alessandro
> >>>> 
> >>>> 2016-08-09 5:22 GMT-06:00 Paul Richard Thomas <
> >>>> paul.richard.thomas@gmail.com>:
> >>>>> Hi Sandro,
> >>>>> 
> >>>>> As far as I can see, this is OK barring a couple of minor wrinkles and
> >>>>> a question:
> >>>>> 
> >>>>> For coarray_failed_images_err.f90 and coarray_image_status_err.f90 you
> >>>>> have used the option -fdump-tree-original without making use of the
> >>>>> tree dump.
> >>>>> 
> >>>>> Mikael asked you to provide an executable test with -fcoarray=single.
> >>>>> Is this not possible for some reason?
> >>>>> 
> >>>>> Otherwise, this is OK for trunk.
> >>>>> 
> >>>>> Thanks for the patch.
> >>>>> 
> >>>>> Paul
> >>>>> 
> >>>>> On 4 August 2016 at 05:07, Alessandro Fanfarillo
> >>>>> <fanfarillo.gcc@gmail.com> wrote:
> >>>>>> * PING *
> >>>>>> 
> >>>>>> 2016-07-21 13:05 GMT-06:00 Alessandro Fanfarillo <
> >>>> fanfarillo.gcc@gmail.com>:
> >>>>>>> Dear Mikael and all,
> >>>>>>> 
> >>>>>>> in attachment the new patch, built and regtested on
> >>>> x86_64-pc-linux-gnu.
> >>>>>>> 
> >>>>>>> Cheers,
> >>>>>>> Alessandro
> >>>>>>> 
> >>>>>>> 2016-07-20 13:17 GMT-06:00 Mikael Morin <morin-mikael@orange.fr>:
> >>>>>>>> Le 20/07/2016 à 11:39, Andre Vehreschild a écrit :
> >>>>>>>>> 
> >>>>>>>>> Hi Mikael,
> >>>>>>>>> 
> >>>>>>>>> 
> >>>>>>>>>>> +  if(st == ST_FAIL_IMAGE)
> >>>>>>>>>>> +    new_st.op = EXEC_FAIL_IMAGE;
> >>>>>>>>>>> +  else
> >>>>>>>>>>> +    gcc_unreachable();
> >>>>>>>>>> 
> >>>>>>>>>> You can use
> >>>>>>>>>>        gcc_assert (st == ST_FAIL_IMAGE);
> >>>>>>>>>>        foo...;
> >>>>>>>>>> instead of
> >>>>>>>>>>        if (st == ST_FAIL_IMAGE)
> >>>>>>>>>>                foo...;
> >>>>>>>>>>        else
> >>>>>>>>>>                gcc_unreachable ();
> >>>>>>>>> 
> >>>>>>>>> 
> >>>>>>>>> Be careful, this is not 100% identical in the general case. For
> >>>>>>>>> older gcc version (gcc < 4008) gcc_assert() is mapped to nothing,
> >>>>>>>>> esp. not
> >>>> to
> >>>>>>>>> an abort(), so the behavior can change. But in this case everything
> >>>> is
> >>>>>>>>> fine, because the patch is most likely not backported.
> >>>>>>>>> 
> >>>>>>>> Didn't know about this. The difference seems to be very subtle.
> >>>>>>>> I don't mind much anyway. The original version can stay if preferred,
> >>>> this
> >>>>>>>> was just a suggestion.
> >>>>>>>> 
> >>>>>>>> By the way, if the function is inlined in its single caller, the
> >>>> assert or
> >>>>>>>> unreachable statement can be removed, which avoids choosing between
> >>>> them.
> >>>>>>>> That's another suggestion.
> >>>>>>>> 
> >>>>>>>> 
> >>>>>>>>>>> +
> >>>>>>>>>>> +  return MATCH_YES;
> >>>>>>>>>>> +
> >>>>>>>>>>> + syntax:
> >>>>>>>>>>> +  gfc_syntax_error (st);
> >>>>>>>>>>> +
> >>>>>>>>>>> +  return MATCH_ERROR;
> >>>>>>>>>>> +}
> >>>>>>>>>>> +
> >>>>>>>>>>> +match
> >>>>>>>>>>> +gfc_match_fail_image (void)
> >>>>>>>>>>> +{
> >>>>>>>>>>> +  /* if (!gfc_notify_std (GFC_STD_F2008_TS, "FAIL IMAGE statement
> >>>>>>>>>>> at %C")) */
> >>>>>>>>>>> +  /*   return MATCH_ERROR; */
> >>>>>>>>>>> +
> >>>>>>>>>> 
> >>>>>>>>>> Can this be uncommented?
> >>>>>>>>>> 
> >>>>>>>>>>> +  return fail_image_statement (ST_FAIL_IMAGE);
> >>>>>>>>>>> +}
> >>>>>>>>>>> 
> >>>>>>>>>>> /* Match LOCK/UNLOCK statement. Syntax:
> >>>>>>>>>>>      LOCK ( lock-variable [ , lock-stat-list ] )
> >>>>>>>>>>> diff --git a/gcc/fortran/trans-intrinsic.c
> >>>>>>>>>>> b/gcc/fortran/trans-intrinsic.c index 1aaf4e2..b2f5596 100644
> >>>>>>>>>>> --- a/gcc/fortran/trans-intrinsic.c
> >>>>>>>>>>> +++ b/gcc/fortran/trans-intrinsic.c
> >>>>>>>>>>> @@ -1647,6 +1647,24 @@ trans_this_image (gfc_se * se, gfc_expr
> >>>>>>>>>>> *expr) m, lbound));
> >>>>>>>>>>> }
> >>>>>>>>>>> 
> >>>>>>>>>>> +static void
> >>>>>>>>>>> +gfc_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);
> >>>>>>>>>>> +
> >>>>>>>>>>> +  if (flag_coarray == GFC_FCOARRAY_LIB)
> >>>>>>>>>>> +    {
> >>>>>>>>>> 
> >>>>>>>>>> Can everything be put under the if?
> >>>>>>>>>> Does it work with -fcoarray=single?
> >>>>>>>>> 
> >>>>>>>>> 
> >>>>>>>>> IMO coarray=single should not generate code here, therefore putting
> >>>>>>>>> everything under the if should to fine.
> >>>>>>>>> 
> >>>>>>>> My point was more avoiding generating code for the arguments if they
> >>>> are not
> >>>>>>>> used in the end.
> >>>>>>>> Regarding the -fcoarray=single case, the function returns a result,
> >>>> which
> >>>>>>>> can be used in an expression, so I don't think it will work without
> >>>> at least
> >>>>>>>> hardcoding a fixed value as result in that case.
> >>>>>>>> But even that wouldn't be enough, as the function wouldn't work
> >>>> consistently
> >>>>>>>> with the fail image statement.
> >>>>>>>> 
> >>>>>>>>> Sorry for the comments ...
> >>>>>>>>> 
> >>>>>>>> Comments are welcome here, as far as I know. ;-)
> >>>>>>>> 
> >>>>>>>> Mikael
> >>>>> 
> >>>>> 
> >>>>> 
> >>>>> --
> >>>>> The difference between genius and stupidity is; genius has its limits.
> >>>>> 
> >>>>> Albert Einstein
> >>>> 
> >> 
> >> 
> >> --
> >> Andre Vehreschild * Email: vehre ad gmx dot de
> > 
> > 
> 
> ________________________________
> Damian Rouson, Ph.D., P.E.
> President, Sourcery Institute
> http://www.sourceryinstitute.org
> +1-510-600-2992 (mobile)
> 


-- 
Andre Vehreschild * Email: vehre ad gmx dot de 

Re: [Fortran, Patch] First patch for coarray FAILED IMAGES (TS 18508)

[Alessandro Fanfarillo]

Hi Andre,
the functions related with failed images are all implemented into the
branch "failed-images-comm" of opencoarrays.

2017-01-18 10:20 GMT-07:00 Andre Vehreschild <vehre@gmx.de>:
> Hi Damian,
>
> the patch you attached showed to be empty in my mail-client. I retrieved it now
> from a former mail on the list. It does not apply cleanly anymore.
>
> I can't okay it, after looking at some of the lines. There is a function call
> declared, but no library function is declared -> link error. Parsing of the
> arguments to FAIL IMAGE looks dubious to me. There are numerous style
> violations. The API-documentation has not been updated.
>
> So no, I will have to work this over before the patch could have a chance to
> get accepted. Sorry.
>
> Regards,
>         Andre
>
> On Tue, 17 Jan 2017 22:39:06 -0800
> Damian Rouson <damian@sourceryinstitute.org> wrote:
>
>> *PING*
>>
>> With the 7.1.0 deadline approaching tomorrow, is there any chance of getting
>> Alessandro’s FAILED IMAGES patch approved for trunk?  As far as I know,
>> Fortran is the first internationally standardized language to incorporate
>> intrinsic support for fault tolerance, which is believed to be essential to
>> reaching exaflop performance.  As far as I know, gfortran is the first
>> compiler to implement this Fortran 2015 feature.  This is a huge deal and I’m
>> hoping Alessandro and I will be able to report that this is a released
>> feature in a talk we’re giving jointly in early February.  Any assistance
>> would be greatly appreciated.
>>
>> Damian
>>
>> > Begin forwarded message:
>> >
>> >
>> > From: Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>
>> > Subject: Re: [Fortran, Patch] First patch for coarray FAILED IMAGES (TS
>> > 18508) Date: September 21, 2016 at 11:03:48 AM PDT
>> > To: Andre Vehreschild <vehre@gmx.de>
>> > Cc: Paul Richard Thomas <paul.richard.thomas@gmail.com>, gfortran
>> > <fortran@gcc.gnu.org>, gcc-patches <gcc-patches@gcc.gnu.org>, Mikael Morin
>> > <morin-mikael@orange.fr>, Tobias Burnus <burnus@net-b.de>
>> >
>> >
>> > Thanks Andre.
>> >
>> > 2016-09-19 9:55 GMT-06:00 Andre Vehreschild <vehre@gmx.de>:
>> >> Hi Alessandro,
>> >
>> >> The if in resolve.c at 8837: resolve_failed_image (... is intentional? It
>> >> is doing nothing. So do you plan to add more code, or will there never be
>> >> anything. If the later I recommend to just put a comment there and remove
>> >> the empty if.
>> >
>> > I added the if statement during the development and I forgot to remove it.
>> >
>> >>
>> >> There still is no test when -fcoarray=single is used. This shouldn't be so
>> >> hard, should it?
>> >
>> > Done.
>> >
>> > Built and regtested on x86_64-pc-linux-gnu.
>> >
>> >>
>> >> Regards,
>> >>        Andre
>> >>
>> >> On Mon, 19 Sep 2016 08:30:12 -0700
>> >> Alessandro Fanfarillo <fanfarillo.gcc@gmail.com> wrote:
>> >>
>> >>> * PING *
>> >>>
>> >>> On Sep 7, 2016 3:01 PM, "Alessandro Fanfarillo" <fanfarillo.gcc@gmail.com>
>> >>> wrote:
>> >>>
>> >>>> Dear all,
>> >>>> the attached patch supports failed images also when -fcoarray=single is
>> >>>> used.
>> >>>>
>> >>>> Built and regtested on x86_64-pc-linux-gnu.
>> >>>>
>> >>>> Cheers,
>> >>>> Alessandro
>> >>>>
>> >>>> 2016-08-09 5:22 GMT-06:00 Paul Richard Thomas <
>> >>>> paul.richard.thomas@gmail.com>:
>> >>>>> Hi Sandro,
>> >>>>>
>> >>>>> As far as I can see, this is OK barring a couple of minor wrinkles and
>> >>>>> a question:
>> >>>>>
>> >>>>> For coarray_failed_images_err.f90 and coarray_image_status_err.f90 you
>> >>>>> have used the option -fdump-tree-original without making use of the
>> >>>>> tree dump.
>> >>>>>
>> >>>>> Mikael asked you to provide an executable test with -fcoarray=single.
>> >>>>> Is this not possible for some reason?
>> >>>>>
>> >>>>> Otherwise, this is OK for trunk.
>> >>>>>
>> >>>>> Thanks for the patch.
>> >>>>>
>> >>>>> Paul
>> >>>>>
>> >>>>> On 4 August 2016 at 05:07, Alessandro Fanfarillo
>> >>>>> <fanfarillo.gcc@gmail.com> wrote:
>> >>>>>> * PING *
>> >>>>>>
>> >>>>>> 2016-07-21 13:05 GMT-06:00 Alessandro Fanfarillo <
>> >>>> fanfarillo.gcc@gmail.com>:
>> >>>>>>> Dear Mikael and all,
>> >>>>>>>
>> >>>>>>> in attachment the new patch, built and regtested on
>> >>>> x86_64-pc-linux-gnu.
>> >>>>>>>
>> >>>>>>> Cheers,
>> >>>>>>> Alessandro
>> >>>>>>>
>> >>>>>>> 2016-07-20 13:17 GMT-06:00 Mikael Morin <morin-mikael@orange.fr>:
>> >>>>>>>> Le 20/07/2016 à 11:39, Andre Vehreschild a écrit :
>> >>>>>>>>>
>> >>>>>>>>> Hi Mikael,
>> >>>>>>>>>
>> >>>>>>>>>
>> >>>>>>>>>>> +  if(st == ST_FAIL_IMAGE)
>> >>>>>>>>>>> +    new_st.op = EXEC_FAIL_IMAGE;
>> >>>>>>>>>>> +  else
>> >>>>>>>>>>> +    gcc_unreachable();
>> >>>>>>>>>>
>> >>>>>>>>>> You can use
>> >>>>>>>>>>        gcc_assert (st == ST_FAIL_IMAGE);
>> >>>>>>>>>>        foo...;
>> >>>>>>>>>> instead of
>> >>>>>>>>>>        if (st == ST_FAIL_IMAGE)
>> >>>>>>>>>>                foo...;
>> >>>>>>>>>>        else
>> >>>>>>>>>>                gcc_unreachable ();
>> >>>>>>>>>
>> >>>>>>>>>
>> >>>>>>>>> Be careful, this is not 100% identical in the general case. For
>> >>>>>>>>> older gcc version (gcc < 4008) gcc_assert() is mapped to nothing,
>> >>>>>>>>> esp. not
>> >>>> to
>> >>>>>>>>> an abort(), so the behavior can change. But in this case everything
>> >>>> is
>> >>>>>>>>> fine, because the patch is most likely not backported.
>> >>>>>>>>>
>> >>>>>>>> Didn't know about this. The difference seems to be very subtle.
>> >>>>>>>> I don't mind much anyway. The original version can stay if preferred,
>> >>>> this
>> >>>>>>>> was just a suggestion.
>> >>>>>>>>
>> >>>>>>>> By the way, if the function is inlined in its single caller, the
>> >>>> assert or
>> >>>>>>>> unreachable statement can be removed, which avoids choosing between
>> >>>> them.
>> >>>>>>>> That's another suggestion.
>> >>>>>>>>
>> >>>>>>>>
>> >>>>>>>>>>> +
>> >>>>>>>>>>> +  return MATCH_YES;
>> >>>>>>>>>>> +
>> >>>>>>>>>>> + syntax:
>> >>>>>>>>>>> +  gfc_syntax_error (st);
>> >>>>>>>>>>> +
>> >>>>>>>>>>> +  return MATCH_ERROR;
>> >>>>>>>>>>> +}
>> >>>>>>>>>>> +
>> >>>>>>>>>>> +match
>> >>>>>>>>>>> +gfc_match_fail_image (void)
>> >>>>>>>>>>> +{
>> >>>>>>>>>>> +  /* if (!gfc_notify_std (GFC_STD_F2008_TS, "FAIL IMAGE statement
>> >>>>>>>>>>> at %C")) */
>> >>>>>>>>>>> +  /*   return MATCH_ERROR; */
>> >>>>>>>>>>> +
>> >>>>>>>>>>
>> >>>>>>>>>> Can this be uncommented?
>> >>>>>>>>>>
>> >>>>>>>>>>> +  return fail_image_statement (ST_FAIL_IMAGE);
>> >>>>>>>>>>> +}
>> >>>>>>>>>>>
>> >>>>>>>>>>> /* Match LOCK/UNLOCK statement. Syntax:
>> >>>>>>>>>>>      LOCK ( lock-variable [ , lock-stat-list ] )
>> >>>>>>>>>>> diff --git a/gcc/fortran/trans-intrinsic.c
>> >>>>>>>>>>> b/gcc/fortran/trans-intrinsic.c index 1aaf4e2..b2f5596 100644
>> >>>>>>>>>>> --- a/gcc/fortran/trans-intrinsic.c
>> >>>>>>>>>>> +++ b/gcc/fortran/trans-intrinsic.c
>> >>>>>>>>>>> @@ -1647,6 +1647,24 @@ trans_this_image (gfc_se * se, gfc_expr
>> >>>>>>>>>>> *expr) m, lbound));
>> >>>>>>>>>>> }
>> >>>>>>>>>>>
>> >>>>>>>>>>> +static void
>> >>>>>>>>>>> +gfc_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);
>> >>>>>>>>>>> +
>> >>>>>>>>>>> +  if (flag_coarray == GFC_FCOARRAY_LIB)
>> >>>>>>>>>>> +    {
>> >>>>>>>>>>
>> >>>>>>>>>> Can everything be put under the if?
>> >>>>>>>>>> Does it work with -fcoarray=single?
>> >>>>>>>>>
>> >>>>>>>>>
>> >>>>>>>>> IMO coarray=single should not generate code here, therefore putting
>> >>>>>>>>> everything under the if should to fine.
>> >>>>>>>>>
>> >>>>>>>> My point was more avoiding generating code for the arguments if they
>> >>>> are not
>> >>>>>>>> used in the end.
>> >>>>>>>> Regarding the -fcoarray=single case, the function returns a result,
>> >>>> which
>> >>>>>>>> can be used in an expression, so I don't think it will work without
>> >>>> at least
>> >>>>>>>> hardcoding a fixed value as result in that case.
>> >>>>>>>> But even that wouldn't be enough, as the function wouldn't work
>> >>>> consistently
>> >>>>>>>> with the fail image statement.
>> >>>>>>>>
>> >>>>>>>>> Sorry for the comments ...
>> >>>>>>>>>
>> >>>>>>>> Comments are welcome here, as far as I know. ;-)
>> >>>>>>>>
>> >>>>>>>> Mikael
>> >>>>>
>> >>>>>
>> >>>>>
>> >>>>> --
>> >>>>> The difference between genius and stupidity is; genius has its limits.
>> >>>>>
>> >>>>> Albert Einstein
>> >>>>
>> >>
>> >>
>> >> --
>> >> Andre Vehreschild * Email: vehre ad gmx dot de
>> >
>> >
>>
>> ________________________________
>> Damian Rouson, Ph.D., P.E.
>> President, Sourcery Institute
>> http://www.sourceryinstitute.org
>> +1-510-600-2992 (mobile)
>>
>
>
> --
> Andre Vehreschild * Email: vehre ad gmx dot de

Re: [Fortran, Patch] First patch for coarray FAILED IMAGES (TS 18508)

[Andre Vehreschild]

Hi Alessandro,

unfortunately we are here on the compiler. And in its test-library the function
fail_image is neither declared nor defined.

- Andre

On Wed, 18 Jan 2017 10:52:25 -0700
Alessandro Fanfarillo <elfanfa@ucar.edu> wrote:

> Hi Andre,
> the functions related with failed images are all implemented into the
> branch "failed-images-comm" of opencoarrays.
> 
> On Wed, Jan 18, 2017 at 10:20 AM, Andre Vehreschild <vehre@gmx.de> wrote:
> 
> > Hi Damian,
> >
> > the patch you attached showed to be empty in my mail-client. I retrieved
> > it now
> > from a former mail on the list. It does not apply cleanly anymore.
> >
> > I can't okay it, after looking at some of the lines. There is a function
> > call
> > declared, but no library function is declared -> link error. Parsing of the
> > arguments to FAIL IMAGE looks dubious to me. There are numerous style
> > violations. The API-documentation has not been updated.
> >
> > So no, I will have to work this over before the patch could have a chance
> > to
> > get accepted. Sorry.
> >
> > Regards,
> >         Andre
> >
> > On Tue, 17 Jan 2017 22:39:06 -0800
> > Damian Rouson <damian@sourceryinstitute.org> wrote:
> >  
> > > *PING*
> > >
> > > With the 7.1.0 deadline approaching tomorrow, is there any chance of  
> > getting  
> > > Alessandro’s FAILED IMAGES patch approved for trunk?  As far as I know,
> > > Fortran is the first internationally standardized language to incorporate
> > > intrinsic support for fault tolerance, which is believed to be essential  
> > to  
> > > reaching exaflop performance.  As far as I know, gfortran is the first
> > > compiler to implement this Fortran 2015 feature.  This is a huge deal  
> > and I’m  
> > > hoping Alessandro and I will be able to report that this is a released
> > > feature in a talk we’re giving jointly in early February.  Any assistance
> > > would be greatly appreciated.
> > >
> > > Damian
> > >  
> > > > Begin forwarded message:
> > > >
> > > >
> > > > From: Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>
> > > > Subject: Re: [Fortran, Patch] First patch for coarray FAILED IMAGES (TS
> > > > 18508) Date: September 21, 2016 at 11:03:48 AM PDT
> > > > To: Andre Vehreschild <vehre@gmx.de>
> > > > Cc: Paul Richard Thomas <paul.richard.thomas@gmail.com>, gfortran
> > > > <fortran@gcc.gnu.org>, gcc-patches <gcc-patches@gcc.gnu.org>, Mikael  
> > Morin  
> > > > <morin-mikael@orange.fr>, Tobias Burnus <burnus@net-b.de>
> > > >
> > > >
> > > > Thanks Andre.
> > > >
> > > > 2016-09-19 9:55 GMT-06:00 Andre Vehreschild <vehre@gmx.de>:  
> > > >> Hi Alessandro,  
> > > >  
> > > >> The if in resolve.c at 8837: resolve_failed_image (... is  
> > intentional? It  
> > > >> is doing nothing. So do you plan to add more code, or will there  
> > never be  
> > > >> anything. If the later I recommend to just put a comment there and  
> > remove  
> > > >> the empty if.  
> > > >
> > > > I added the if statement during the development and I forgot to remove  
> > it.  
> > > >  
> > > >>
> > > >> There still is no test when -fcoarray=single is used. This shouldn't  
> > be so  
> > > >> hard, should it?  
> > > >
> > > > Done.
> > > >
> > > > Built and regtested on x86_64-pc-linux-gnu.
> > > >  
> > > >>
> > > >> Regards,
> > > >>        Andre
> > > >>
> > > >> On Mon, 19 Sep 2016 08:30:12 -0700
> > > >> Alessandro Fanfarillo <fanfarillo.gcc@gmail.com> wrote:
> > > >>  
> > > >>> * PING *
> > > >>>
> > > >>> On Sep 7, 2016 3:01 PM, "Alessandro Fanfarillo" <  
> > fanfarillo.gcc@gmail.com>  
> > > >>> wrote:
> > > >>>  
> > > >>>> Dear all,
> > > >>>> the attached patch supports failed images also when  
> > -fcoarray=single is  
> > > >>>> used.
> > > >>>>
> > > >>>> Built and regtested on x86_64-pc-linux-gnu.
> > > >>>>
> > > >>>> Cheers,
> > > >>>> Alessandro
> > > >>>>
> > > >>>> 2016-08-09 5:22 GMT-06:00 Paul Richard Thomas <  
> > > >>>> paul.richard.thomas@gmail.com>:
> > > >>>>> Hi Sandro,
> > > >>>>>
> > > >>>>> As far as I can see, this is OK barring a couple of minor wrinkles  
> > and  
> > > >>>>> a question:
> > > >>>>>
> > > >>>>> For coarray_failed_images_err.f90 and coarray_image_status_err.f90  
> > you  
> > > >>>>> have used the option -fdump-tree-original without making use of the
> > > >>>>> tree dump.
> > > >>>>>
> > > >>>>> Mikael asked you to provide an executable test with  
> > -fcoarray=single.  
> > > >>>>> Is this not possible for some reason?
> > > >>>>>
> > > >>>>> Otherwise, this is OK for trunk.
> > > >>>>>
> > > >>>>> Thanks for the patch.
> > > >>>>>
> > > >>>>> Paul
> > > >>>>>
> > > >>>>> On 4 August 2016 at 05:07, Alessandro Fanfarillo
> > > >>>>> <fanfarillo.gcc@gmail.com> wrote:  
> > > >>>>>> * PING *
> > > >>>>>>
> > > >>>>>> 2016-07-21 13:05 GMT-06:00 Alessandro Fanfarillo <  
> > > >>>> fanfarillo.gcc@gmail.com>:  
> > > >>>>>>> Dear Mikael and all,
> > > >>>>>>>
> > > >>>>>>> in attachment the new patch, built and regtested on  
> > > >>>> x86_64-pc-linux-gnu.  
> > > >>>>>>>
> > > >>>>>>> Cheers,
> > > >>>>>>> Alessandro
> > > >>>>>>>
> > > >>>>>>> 2016-07-20 13:17 GMT-06:00 Mikael Morin <morin-mikael@orange.fr  
> > >:  
> > > >>>>>>>> Le 20/07/2016 à 11:39, Andre Vehreschild a écrit :  
> > > >>>>>>>>>
> > > >>>>>>>>> Hi Mikael,
> > > >>>>>>>>>
> > > >>>>>>>>>  
> > > >>>>>>>>>>> +  if(st == ST_FAIL_IMAGE)
> > > >>>>>>>>>>> +    new_st.op = EXEC_FAIL_IMAGE;
> > > >>>>>>>>>>> +  else
> > > >>>>>>>>>>> +    gcc_unreachable();  
> > > >>>>>>>>>>
> > > >>>>>>>>>> You can use
> > > >>>>>>>>>>        gcc_assert (st == ST_FAIL_IMAGE);
> > > >>>>>>>>>>        foo...;
> > > >>>>>>>>>> instead of
> > > >>>>>>>>>>        if (st == ST_FAIL_IMAGE)
> > > >>>>>>>>>>                foo...;
> > > >>>>>>>>>>        else
> > > >>>>>>>>>>                gcc_unreachable ();  
> > > >>>>>>>>>
> > > >>>>>>>>>
> > > >>>>>>>>> Be careful, this is not 100% identical in the general case. For
> > > >>>>>>>>> older gcc version (gcc < 4008) gcc_assert() is mapped to  
> > nothing,  
> > > >>>>>>>>> esp. not  
> > > >>>> to  
> > > >>>>>>>>> an abort(), so the behavior can change. But in this case  
> > everything  
> > > >>>> is  
> > > >>>>>>>>> fine, because the patch is most likely not backported.
> > > >>>>>>>>>  
> > > >>>>>>>> Didn't know about this. The difference seems to be very subtle.
> > > >>>>>>>> I don't mind much anyway. The original version can stay if  
> > preferred,  
> > > >>>> this  
> > > >>>>>>>> was just a suggestion.
> > > >>>>>>>>
> > > >>>>>>>> By the way, if the function is inlined in its single caller,
> > > >>>>>>>> the  
> > > >>>> assert or  
> > > >>>>>>>> unreachable statement can be removed, which avoids choosing  
> > between  
> > > >>>> them.  
> > > >>>>>>>> That's another suggestion.
> > > >>>>>>>>
> > > >>>>>>>>  
> > > >>>>>>>>>>> +
> > > >>>>>>>>>>> +  return MATCH_YES;
> > > >>>>>>>>>>> +
> > > >>>>>>>>>>> + syntax:
> > > >>>>>>>>>>> +  gfc_syntax_error (st);
> > > >>>>>>>>>>> +
> > > >>>>>>>>>>> +  return MATCH_ERROR;
> > > >>>>>>>>>>> +}
> > > >>>>>>>>>>> +
> > > >>>>>>>>>>> +match
> > > >>>>>>>>>>> +gfc_match_fail_image (void)
> > > >>>>>>>>>>> +{
> > > >>>>>>>>>>> +  /* if (!gfc_notify_std (GFC_STD_F2008_TS, "FAIL IMAGE  
> > statement  
> > > >>>>>>>>>>> at %C")) */
> > > >>>>>>>>>>> +  /*   return MATCH_ERROR; */
> > > >>>>>>>>>>> +  
> > > >>>>>>>>>>
> > > >>>>>>>>>> Can this be uncommented?
> > > >>>>>>>>>>  
> > > >>>>>>>>>>> +  return fail_image_statement (ST_FAIL_IMAGE);
> > > >>>>>>>>>>> +}
> > > >>>>>>>>>>>
> > > >>>>>>>>>>> /* Match LOCK/UNLOCK statement. Syntax:
> > > >>>>>>>>>>>      LOCK ( lock-variable [ , lock-stat-list ] )
> > > >>>>>>>>>>> diff --git a/gcc/fortran/trans-intrinsic.c
> > > >>>>>>>>>>> b/gcc/fortran/trans-intrinsic.c index 1aaf4e2..b2f5596  
> > 100644  
> > > >>>>>>>>>>> --- a/gcc/fortran/trans-intrinsic.c
> > > >>>>>>>>>>> +++ b/gcc/fortran/trans-intrinsic.c
> > > >>>>>>>>>>> @@ -1647,6 +1647,24 @@ trans_this_image (gfc_se * se,  
> > gfc_expr  
> > > >>>>>>>>>>> *expr) m, lbound));
> > > >>>>>>>>>>> }
> > > >>>>>>>>>>>
> > > >>>>>>>>>>> +static void
> > > >>>>>>>>>>> +gfc_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);  
> > > >>>>>>>>>>> +
> > > >>>>>>>>>>> +  if (flag_coarray == GFC_FCOARRAY_LIB)
> > > >>>>>>>>>>> +    {  
> > > >>>>>>>>>>
> > > >>>>>>>>>> Can everything be put under the if?
> > > >>>>>>>>>> Does it work with -fcoarray=single?  
> > > >>>>>>>>>
> > > >>>>>>>>>
> > > >>>>>>>>> IMO coarray=single should not generate code here, therefore  
> > putting  
> > > >>>>>>>>> everything under the if should to fine.
> > > >>>>>>>>>  
> > > >>>>>>>> My point was more avoiding generating code for the arguments if  
> > they  
> > > >>>> are not  
> > > >>>>>>>> used in the end.
> > > >>>>>>>> Regarding the -fcoarray=single case, the function returns a  
> > result,  
> > > >>>> which  
> > > >>>>>>>> can be used in an expression, so I don't think it will work  
> > without  
> > > >>>> at least  
> > > >>>>>>>> hardcoding a fixed value as result in that case.
> > > >>>>>>>> But even that wouldn't be enough, as the function wouldn't work  
> > > >>>> consistently  
> > > >>>>>>>> with the fail image statement.
> > > >>>>>>>>  
> > > >>>>>>>>> Sorry for the comments ...
> > > >>>>>>>>>  
> > > >>>>>>>> Comments are welcome here, as far as I know. ;-)
> > > >>>>>>>>
> > > >>>>>>>> Mikael  
> > > >>>>>
> > > >>>>>
> > > >>>>>
> > > >>>>> --
> > > >>>>> The difference between genius and stupidity is; genius has its  
> > limits.  
> > > >>>>>
> > > >>>>> Albert Einstein  
> > > >>>>  
> > > >>
> > > >>
> > > >> --
> > > >> Andre Vehreschild * Email: vehre ad gmx dot de  
> > > >
> > > >  
> > >
> > > ________________________________
> > > Damian Rouson, Ph.D., P.E.
> > > President, Sourcery Institute
> > > http://www.sourceryinstitute.org
> > > +1-510-600-2992 (mobile)
> > >  
> >
> >
> > --
> > Andre Vehreschild * Email: vehre ad gmx dot de
> >  
> 
> 
> 


-- 
Andre Vehreschild * Email: vehre ad gmx dot de 

Re: [Fortran, Patch] First patch for coarray FAILED IMAGES (TS 18508)

[Alessandro Fanfarillo]

I guess implementing this function in libcaf_single should fix the
problem, right?
Furthermore, FAIL IMAGE is a statement, it doesn't take any arguments.
Anyway, I will re-adapt the patch to the current trunk and will
address all the issues.

All comments/observations are more than welcome.

2017-01-18 11:01 GMT-07:00 Andre Vehreschild <vehre@gmx.de>:
> Hi Alessandro,
>
> unfortunately we are here on the compiler. And in its test-library the function
> fail_image is neither declared nor defined.
>
> - Andre
>
> On Wed, 18 Jan 2017 10:52:25 -0700
> Alessandro Fanfarillo <elfanfa@ucar.edu> wrote:
>
>> Hi Andre,
>> the functions related with failed images are all implemented into the
>> branch "failed-images-comm" of opencoarrays.
>>
>> On Wed, Jan 18, 2017 at 10:20 AM, Andre Vehreschild <vehre@gmx.de> wrote:
>>
>> > Hi Damian,
>> >
>> > the patch you attached showed to be empty in my mail-client. I retrieved
>> > it now
>> > from a former mail on the list. It does not apply cleanly anymore.
>> >
>> > I can't okay it, after looking at some of the lines. There is a function
>> > call
>> > declared, but no library function is declared -> link error. Parsing of the
>> > arguments to FAIL IMAGE looks dubious to me. There are numerous style
>> > violations. The API-documentation has not been updated.
>> >
>> > So no, I will have to work this over before the patch could have a chance
>> > to
>> > get accepted. Sorry.
>> >
>> > Regards,
>> >         Andre
>> >
>> > On Tue, 17 Jan 2017 22:39:06 -0800
>> > Damian Rouson <damian@sourceryinstitute.org> wrote:
>> >
>> > > *PING*
>> > >
>> > > With the 7.1.0 deadline approaching tomorrow, is there any chance of
>> > getting
>> > > Alessandro’s FAILED IMAGES patch approved for trunk?  As far as I know,
>> > > Fortran is the first internationally standardized language to incorporate
>> > > intrinsic support for fault tolerance, which is believed to be essential
>> > to
>> > > reaching exaflop performance.  As far as I know, gfortran is the first
>> > > compiler to implement this Fortran 2015 feature.  This is a huge deal
>> > and I’m
>> > > hoping Alessandro and I will be able to report that this is a released
>> > > feature in a talk we’re giving jointly in early February.  Any assistance
>> > > would be greatly appreciated.
>> > >
>> > > Damian
>> > >
>> > > > Begin forwarded message:
>> > > >
>> > > >
>> > > > From: Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>
>> > > > Subject: Re: [Fortran, Patch] First patch for coarray FAILED IMAGES (TS
>> > > > 18508) Date: September 21, 2016 at 11:03:48 AM PDT
>> > > > To: Andre Vehreschild <vehre@gmx.de>
>> > > > Cc: Paul Richard Thomas <paul.richard.thomas@gmail.com>, gfortran
>> > > > <fortran@gcc.gnu.org>, gcc-patches <gcc-patches@gcc.gnu.org>, Mikael
>> > Morin
>> > > > <morin-mikael@orange.fr>, Tobias Burnus <burnus@net-b.de>
>> > > >
>> > > >
>> > > > Thanks Andre.
>> > > >
>> > > > 2016-09-19 9:55 GMT-06:00 Andre Vehreschild <vehre@gmx.de>:
>> > > >> Hi Alessandro,
>> > > >
>> > > >> The if in resolve.c at 8837: resolve_failed_image (... is
>> > intentional? It
>> > > >> is doing nothing. So do you plan to add more code, or will there
>> > never be
>> > > >> anything. If the later I recommend to just put a comment there and
>> > remove
>> > > >> the empty if.
>> > > >
>> > > > I added the if statement during the development and I forgot to remove
>> > it.
>> > > >
>> > > >>
>> > > >> There still is no test when -fcoarray=single is used. This shouldn't
>> > be so
>> > > >> hard, should it?
>> > > >
>> > > > Done.
>> > > >
>> > > > Built and regtested on x86_64-pc-linux-gnu.
>> > > >
>> > > >>
>> > > >> Regards,
>> > > >>        Andre
>> > > >>
>> > > >> On Mon, 19 Sep 2016 08:30:12 -0700
>> > > >> Alessandro Fanfarillo <fanfarillo.gcc@gmail.com> wrote:
>> > > >>
>> > > >>> * PING *
>> > > >>>
>> > > >>> On Sep 7, 2016 3:01 PM, "Alessandro Fanfarillo" <
>> > fanfarillo.gcc@gmail.com>
>> > > >>> wrote:
>> > > >>>
>> > > >>>> Dear all,
>> > > >>>> the attached patch supports failed images also when
>> > -fcoarray=single is
>> > > >>>> used.
>> > > >>>>
>> > > >>>> Built and regtested on x86_64-pc-linux-gnu.
>> > > >>>>
>> > > >>>> Cheers,
>> > > >>>> Alessandro
>> > > >>>>
>> > > >>>> 2016-08-09 5:22 GMT-06:00 Paul Richard Thomas <
>> > > >>>> paul.richard.thomas@gmail.com>:
>> > > >>>>> Hi Sandro,
>> > > >>>>>
>> > > >>>>> As far as I can see, this is OK barring a couple of minor wrinkles
>> > and
>> > > >>>>> a question:
>> > > >>>>>
>> > > >>>>> For coarray_failed_images_err.f90 and coarray_image_status_err.f90
>> > you
>> > > >>>>> have used the option -fdump-tree-original without making use of the
>> > > >>>>> tree dump.
>> > > >>>>>
>> > > >>>>> Mikael asked you to provide an executable test with
>> > -fcoarray=single.
>> > > >>>>> Is this not possible for some reason?
>> > > >>>>>
>> > > >>>>> Otherwise, this is OK for trunk.
>> > > >>>>>
>> > > >>>>> Thanks for the patch.
>> > > >>>>>
>> > > >>>>> Paul
>> > > >>>>>
>> > > >>>>> On 4 August 2016 at 05:07, Alessandro Fanfarillo
>> > > >>>>> <fanfarillo.gcc@gmail.com> wrote:
>> > > >>>>>> * PING *
>> > > >>>>>>
>> > > >>>>>> 2016-07-21 13:05 GMT-06:00 Alessandro Fanfarillo <
>> > > >>>> fanfarillo.gcc@gmail.com>:
>> > > >>>>>>> Dear Mikael and all,
>> > > >>>>>>>
>> > > >>>>>>> in attachment the new patch, built and regtested on
>> > > >>>> x86_64-pc-linux-gnu.
>> > > >>>>>>>
>> > > >>>>>>> Cheers,
>> > > >>>>>>> Alessandro
>> > > >>>>>>>
>> > > >>>>>>> 2016-07-20 13:17 GMT-06:00 Mikael Morin <morin-mikael@orange.fr
>> > >:
>> > > >>>>>>>> Le 20/07/2016 à 11:39, Andre Vehreschild a écrit :
>> > > >>>>>>>>>
>> > > >>>>>>>>> Hi Mikael,
>> > > >>>>>>>>>
>> > > >>>>>>>>>
>> > > >>>>>>>>>>> +  if(st == ST_FAIL_IMAGE)
>> > > >>>>>>>>>>> +    new_st.op = EXEC_FAIL_IMAGE;
>> > > >>>>>>>>>>> +  else
>> > > >>>>>>>>>>> +    gcc_unreachable();
>> > > >>>>>>>>>>
>> > > >>>>>>>>>> You can use
>> > > >>>>>>>>>>        gcc_assert (st == ST_FAIL_IMAGE);
>> > > >>>>>>>>>>        foo...;
>> > > >>>>>>>>>> instead of
>> > > >>>>>>>>>>        if (st == ST_FAIL_IMAGE)
>> > > >>>>>>>>>>                foo...;
>> > > >>>>>>>>>>        else
>> > > >>>>>>>>>>                gcc_unreachable ();
>> > > >>>>>>>>>
>> > > >>>>>>>>>
>> > > >>>>>>>>> Be careful, this is not 100% identical in the general case. For
>> > > >>>>>>>>> older gcc version (gcc < 4008) gcc_assert() is mapped to
>> > nothing,
>> > > >>>>>>>>> esp. not
>> > > >>>> to
>> > > >>>>>>>>> an abort(), so the behavior can change. But in this case
>> > everything
>> > > >>>> is
>> > > >>>>>>>>> fine, because the patch is most likely not backported.
>> > > >>>>>>>>>
>> > > >>>>>>>> Didn't know about this. The difference seems to be very subtle.
>> > > >>>>>>>> I don't mind much anyway. The original version can stay if
>> > preferred,
>> > > >>>> this
>> > > >>>>>>>> was just a suggestion.
>> > > >>>>>>>>
>> > > >>>>>>>> By the way, if the function is inlined in its single caller,
>> > > >>>>>>>> the
>> > > >>>> assert or
>> > > >>>>>>>> unreachable statement can be removed, which avoids choosing
>> > between
>> > > >>>> them.
>> > > >>>>>>>> That's another suggestion.
>> > > >>>>>>>>
>> > > >>>>>>>>
>> > > >>>>>>>>>>> +
>> > > >>>>>>>>>>> +  return MATCH_YES;
>> > > >>>>>>>>>>> +
>> > > >>>>>>>>>>> + syntax:
>> > > >>>>>>>>>>> +  gfc_syntax_error (st);
>> > > >>>>>>>>>>> +
>> > > >>>>>>>>>>> +  return MATCH_ERROR;
>> > > >>>>>>>>>>> +}
>> > > >>>>>>>>>>> +
>> > > >>>>>>>>>>> +match
>> > > >>>>>>>>>>> +gfc_match_fail_image (void)
>> > > >>>>>>>>>>> +{
>> > > >>>>>>>>>>> +  /* if (!gfc_notify_std (GFC_STD_F2008_TS, "FAIL IMAGE
>> > statement
>> > > >>>>>>>>>>> at %C")) */
>> > > >>>>>>>>>>> +  /*   return MATCH_ERROR; */
>> > > >>>>>>>>>>> +
>> > > >>>>>>>>>>
>> > > >>>>>>>>>> Can this be uncommented?
>> > > >>>>>>>>>>
>> > > >>>>>>>>>>> +  return fail_image_statement (ST_FAIL_IMAGE);
>> > > >>>>>>>>>>> +}
>> > > >>>>>>>>>>>
>> > > >>>>>>>>>>> /* Match LOCK/UNLOCK statement. Syntax:
>> > > >>>>>>>>>>>      LOCK ( lock-variable [ , lock-stat-list ] )
>> > > >>>>>>>>>>> diff --git a/gcc/fortran/trans-intrinsic.c
>> > > >>>>>>>>>>> b/gcc/fortran/trans-intrinsic.c index 1aaf4e2..b2f5596
>> > 100644
>> > > >>>>>>>>>>> --- a/gcc/fortran/trans-intrinsic.c
>> > > >>>>>>>>>>> +++ b/gcc/fortran/trans-intrinsic.c
>> > > >>>>>>>>>>> @@ -1647,6 +1647,24 @@ trans_this_image (gfc_se * se,
>> > gfc_expr
>> > > >>>>>>>>>>> *expr) m, lbound));
>> > > >>>>>>>>>>> }
>> > > >>>>>>>>>>>
>> > > >>>>>>>>>>> +static void
>> > > >>>>>>>>>>> +gfc_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);
>> > > >>>>>>>>>>> +
>> > > >>>>>>>>>>> +  if (flag_coarray == GFC_FCOARRAY_LIB)
>> > > >>>>>>>>>>> +    {
>> > > >>>>>>>>>>
>> > > >>>>>>>>>> Can everything be put under the if?
>> > > >>>>>>>>>> Does it work with -fcoarray=single?
>> > > >>>>>>>>>
>> > > >>>>>>>>>
>> > > >>>>>>>>> IMO coarray=single should not generate code here, therefore
>> > putting
>> > > >>>>>>>>> everything under the if should to fine.
>> > > >>>>>>>>>
>> > > >>>>>>>> My point was more avoiding generating code for the arguments if
>> > they
>> > > >>>> are not
>> > > >>>>>>>> used in the end.
>> > > >>>>>>>> Regarding the -fcoarray=single case, the function returns a
>> > result,
>> > > >>>> which
>> > > >>>>>>>> can be used in an expression, so I don't think it will work
>> > without
>> > > >>>> at least
>> > > >>>>>>>> hardcoding a fixed value as result in that case.
>> > > >>>>>>>> But even that wouldn't be enough, as the function wouldn't work
>> > > >>>> consistently
>> > > >>>>>>>> with the fail image statement.
>> > > >>>>>>>>
>> > > >>>>>>>>> Sorry for the comments ...
>> > > >>>>>>>>>
>> > > >>>>>>>> Comments are welcome here, as far as I know. ;-)
>> > > >>>>>>>>
>> > > >>>>>>>> Mikael
>> > > >>>>>
>> > > >>>>>
>> > > >>>>>
>> > > >>>>> --
>> > > >>>>> The difference between genius and stupidity is; genius has its
>> > limits.
>> > > >>>>>
>> > > >>>>> Albert Einstein
>> > > >>>>
>> > > >>
>> > > >>
>> > > >> --
>> > > >> Andre Vehreschild * Email: vehre ad gmx dot de
>> > > >
>> > > >
>> > >
>> > > ________________________________
>> > > Damian Rouson, Ph.D., P.E.
>> > > President, Sourcery Institute
>> > > http://www.sourceryinstitute.org
>> > > +1-510-600-2992 (mobile)
>> > >
>> >
>> >
>> > --
>> > Andre Vehreschild * Email: vehre ad gmx dot de
>> >
>>
>>
>>
>
>
> --
> Andre Vehreschild * Email: vehre ad gmx dot de