Draft patch: Fortran 2015 teams support and extension

Draft patch: Fortran 2015 teams support and extension

[Damian Rouson]

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

All,

With Alessandro’s approval, I’m submitting the attached draft patch showing his edits for supporting Fortran 2015 teams, which in my estimation is the one remaining big piece of Fortran 2015 missing from gfortran.  The patch also adds an extension: a get_communicator function that returns an MPI communicator if libcaf_mpi is the linked ABI.  There are known issues with the team_number function, but it works for the attached tests. I believe Alessandro might have time to work on team_number in a couple of weeks.  Also, there are known issues with teams that contain failed images.  I’m hopeful that entering Cranfield University Ph.D. student Soren Rasmussen will work on the interaction with failed images as a much longer-term project that will not make it into this patch.  

I’m submitting this now to request a review that will give us early guidance regarding the necessary steps for this patch to be approved for committing to the trunk.  I’ve also created a pull request on GitHub that provides a graphical interface to all the changes and allows for adding comments, including comments tied specific lines:

https://github.com/gcc-mirror/gcc/pull/14

It would be great if review comments could be inserted at the above URL (click the Commits tab and then the first commit), but replies to this email are also welcome.  To test this patch, build the opencoarrays-teams branch of OpenCoarrays and the teams branch of the following fork of the GCC git mirror: https://github.com/sourceryinstitute/gcc.

I have not created a ChangeLog but would be glad to do so if someone can explain the process unless that’s too preliminary at this stage.


Damian



[-- Attachment #2: 0001-Team-patch-applied.patch --]
[-- Type: application/octet-stream, Size: 31497 bytes --]

From 9e479120e3b319db67925e1953278836d4cca200 Mon Sep 17 00:00:00 2001
From: Alessandro Fanfarillo <fanfarillo@ing.uniroma2.it>
Date: Wed, 2 Aug 2017 13:26:04 -0500
Subject: [PATCH] Team patch applied

---
 gcc/fortran/array.c             |  17 ++++-
 gcc/fortran/check.c             |  14 +++++
 gcc/fortran/dump-parse-tree.c   |  16 +++++
 gcc/fortran/expr.c              |  18 ++++++
 gcc/fortran/gfortran.h          |   7 ++-
 gcc/fortran/intrinsic.c         |   7 +++
 gcc/fortran/intrinsic.h         |   3 +
 gcc/fortran/iresolve.c          |  12 ++++
 gcc/fortran/iso-fortran-env.def |   7 ++-
 gcc/fortran/match.c             | 135 +++++++++++++++++++++++++++++++++++++++-
 gcc/fortran/match.h             |   4 ++
 gcc/fortran/parse.c             |  23 ++++++-
 gcc/fortran/resolve.c           |  12 ++++
 gcc/fortran/simplify.c          |  22 +++++++
 gcc/fortran/st.c                |   4 ++
 gcc/fortran/trans-decl.c        |  36 ++++++++++-
 gcc/fortran/trans-intrinsic.c   |  24 +++++--
 gcc/fortran/trans-stmt.c        | 109 ++++++++++++++++++++++++++++++++
 gcc/fortran/trans-stmt.h        |   4 ++
 gcc/fortran/trans-types.c       |   6 +-
 gcc/fortran/trans.c             |  16 +++++
 gcc/fortran/trans.h             |   5 ++
 22 files changed, 487 insertions(+), 14 deletions(-)

diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c
index 46642bb5d97..dc1d272dd0a 100644
--- a/gcc/fortran/array.c
+++ b/gcc/fortran/array.c
@@ -158,7 +158,8 @@ gfc_match_array_ref (gfc_array_ref *ar, gfc_array_spec *as, int init,
   bool matched_bracket = false;
   gfc_expr *tmp;
   bool stat_just_seen = false;
-
+  bool team_just_seen = false;
+  
   memset (ar, '\0', sizeof (*ar));
 
   ar->where = gfc_current_locus;
@@ -230,7 +231,21 @@ coarray:
       if (m == MATCH_ERROR)
 	return MATCH_ERROR;
 
+      team_just_seen = false;
       stat_just_seen = false;
+
+      if (gfc_match(" , team = %e",&tmp) == MATCH_YES && ar->stat == NULL)
+	{
+	  ar->team = tmp;
+	  team_just_seen = true;
+	}
+
+      if (ar->team && !team_just_seen)
+	{
+	  gfc_error ("TEAM= attribute in %C misplaced");
+	  return MATCH_ERROR;
+	}
+      
       if (gfc_match(" , stat = %e",&tmp) == MATCH_YES && ar->stat == NULL)
 	{
 	  ar->stat = tmp;
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index e85e398cd43..ab1985d8816 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -1213,6 +1213,20 @@ gfc_check_failed_or_stopped_images (gfc_expr *team, gfc_expr *kind)
   return true;
 }
 
+bool
+gfc_check_get_team (gfc_expr *level)
+{
+  if (level)
+    {
+      gfc_error ("%qs argument of %qs intrinsic at %L not yet supported",
+		 gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic,
+		 &level->where);
+      return false;
+    }
+
+  return true;
+}
+
 
 bool
 gfc_check_atomic_cas (gfc_expr *atom, gfc_expr *old, gfc_expr *compare,
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 46b3705f4f8..f98f47caa5e 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1826,6 +1826,22 @@ show_code_node (int level, gfc_code *c)
       fputs ("FAIL IMAGE ", dumpfile);
       break;
 
+    case EXEC_CHANGE_TEAM:
+      fputs ("CHANGE TEAM", dumpfile);
+      break;
+
+    case EXEC_END_TEAM:
+      fputs ("END TEAM", dumpfile);
+      break;
+
+    case EXEC_FORM_TEAM:
+      fputs ("FORM TEAM", dumpfile);
+      break;
+
+    case EXEC_SYNC_TEAM:
+      fputs ("SYNC TEAM", dumpfile);
+      break;
+
     case EXEC_SYNC_ALL:
       fputs ("SYNC ALL ", dumpfile);
       if (c->expr2 != NULL)
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index d19e2fdde44..f4601d3f95a 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -4851,6 +4851,24 @@ gfc_ref_this_image (gfc_ref *ref)
 }
 
 gfc_expr *
+gfc_find_team_co(gfc_expr *e)
+{
+  gfc_ref *ref;
+
+  for (ref = e->ref; ref; ref = ref->next)
+    if (ref->type == REF_ARRAY && ref->u.ar.codimen > 0)
+      return ref->u.ar.team;
+
+  if (e->value.function.actual->expr)
+    for (ref = e->value.function.actual->expr->ref; ref;
+	 ref = ref->next)
+      if (ref->type == REF_ARRAY && ref->u.ar.codimen > 0)
+	return ref->u.ar.team;
+
+  return NULL;
+}
+
+gfc_expr *
 gfc_find_stat_co(gfc_expr *e)
 {
   gfc_ref *ref;
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 26b89bee98e..1be4cb308af 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -263,7 +263,8 @@ enum gfc_statement
   ST_OMP_TASKLOOP_SIMD, ST_OMP_END_TASKLOOP_SIMD, ST_OMP_ORDERED_DEPEND,
   ST_PROCEDURE, ST_GENERIC, ST_CRITICAL, ST_END_CRITICAL,
   ST_GET_FCN_CHARACTERISTICS, ST_LOCK, ST_UNLOCK, ST_EVENT_POST,
-  ST_EVENT_WAIT,ST_FAIL_IMAGE,ST_NONE
+  ST_EVENT_WAIT, ST_FAIL_IMAGE, ST_FORM_TEAM, ST_CHANGE_TEAM,
+  ST_END_TEAM, ST_SYNC_TEAM, ST_NONE
 };
 
 /* Types of interfaces that we can have.  Assignment interfaces are
@@ -456,6 +457,7 @@ enum gfc_isym_id
   GFC_ISYM_GETLOG,
   GFC_ISYM_GETPID,
   GFC_ISYM_GETUID,
+  GFC_ISYM_GET_TEAM,
   GFC_ISYM_GMTIME,
   GFC_ISYM_HOSTNM,
   GFC_ISYM_HUGE,
@@ -1889,6 +1891,7 @@ typedef struct gfc_array_ref
   int dimen;			/* # of components in the reference */
   int codimen;
   bool in_allocate;		/* For coarray checks. */
+  gfc_expr *team;
   gfc_expr *stat;
   locus where;
   gfc_array_spec *as;
@@ -2461,6 +2464,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_FORM_TEAM, EXEC_CHANGE_TEAM, EXEC_END_TEAM, EXEC_SYNC_TEAM,
   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,
@@ -3154,6 +3158,7 @@ bool gfc_is_coarray (gfc_expr *);
 int gfc_get_corank (gfc_expr *);
 bool gfc_has_ultimate_allocatable (gfc_expr *);
 bool gfc_has_ultimate_pointer (gfc_expr *);
+gfc_expr* gfc_find_team_co (gfc_expr *);
 gfc_expr* gfc_find_stat_co (gfc_expr *);
 gfc_expr* gfc_build_intrinsic_call (gfc_namespace *, gfc_isym_id, const char*,
 				    locus, unsigned, ...);
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 2f60fe8c877..55977abe05a 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -1938,6 +1938,13 @@ add_functions (void)
 
   make_generic ("getpid", GFC_ISYM_GETPID, GFC_STD_GNU);
 
+  add_sym_1 ("get_team", GFC_ISYM_GET_TEAM, CLASS_TRANSFORMATIONAL,
+	     ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008_TS,
+	     gfc_check_get_team,
+	     NULL,
+	     gfc_resolve_get_team,
+	     "level", BT_INTEGER, di, OPTIONAL);
+
   add_sym_0 ("getuid", GFC_ISYM_GETUID, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
 	     di, GFC_STD_GNU, NULL, NULL, gfc_resolve_getuid);
 
diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h
index e8280f6f2ac..89b34c0dd9d 100644
--- a/gcc/fortran/intrinsic.h
+++ b/gcc/fortran/intrinsic.h
@@ -83,6 +83,7 @@ bool gfc_check_fn_r (gfc_expr *);
 bool gfc_check_fn_rc (gfc_expr *);
 bool gfc_check_fn_rc2008 (gfc_expr *);
 bool gfc_check_fnum (gfc_expr *);
+bool gfc_check_get_team (gfc_expr *);
 bool gfc_check_hostnm (gfc_expr *);
 bool gfc_check_huge (gfc_expr *);
 bool gfc_check_hypot (gfc_expr *, gfc_expr *);
@@ -299,6 +300,7 @@ gfc_expr *gfc_simplify_float (gfc_expr *);
 gfc_expr *gfc_simplify_floor (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_fraction (gfc_expr *);
 gfc_expr *gfc_simplify_gamma (gfc_expr *);
+gfc_expr *gfc_simplify_get_team (gfc_expr *);
 gfc_expr *gfc_simplify_huge (gfc_expr *);
 gfc_expr *gfc_simplify_hypot (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_iachar (gfc_expr *, gfc_expr *);
@@ -493,6 +495,7 @@ void gfc_resolve_gamma (gfc_expr *, gfc_expr *);
 void gfc_resolve_getcwd (gfc_expr *, gfc_expr *);
 void gfc_resolve_getgid (gfc_expr *);
 void gfc_resolve_getpid (gfc_expr *);
+void gfc_resolve_get_team (gfc_expr *, gfc_expr *);
 void gfc_resolve_getuid (gfc_expr *);
 void gfc_resolve_hostnm (gfc_expr *, gfc_expr *);
 void gfc_resolve_hypot (gfc_expr *, gfc_expr *, gfc_expr *);
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index b784ac339e9..4c3f6e3f6a9 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -2859,6 +2859,18 @@ gfc_resolve_image_status (gfc_expr *f, gfc_expr *image ATTRIBUTE_UNUSED,
   f->value.function.name = image_status;
 }
 
+/* Resolve get_team ().  */
+
+void
+gfc_resolve_get_team (gfc_expr *f, gfc_expr *level ATTRIBUTE_UNUSED)
+{
+  static char get_team[] = "_gfortran_caf_get_team";
+  f->rank = 0;
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_default_integer_kind;
+  f->value.function.name = get_team;
+}
+
 
 /* Resolve image_index (...).  */
 
diff --git a/gcc/fortran/iso-fortran-env.def b/gcc/fortran/iso-fortran-env.def
index 8e231a6330a..9a2df57c6c9 100644
--- a/gcc/fortran/iso-fortran-env.def
+++ b/gcc/fortran/iso-fortran-env.def
@@ -125,7 +125,12 @@ NAMED_DERIVED_TYPE (ISOFORTRAN_LOCK_TYPE, "lock_type", \
 
 NAMED_DERIVED_TYPE (ISOFORTRAN_EVENT_TYPE, "event_type", \
 		    flag_coarray == GFC_FCOARRAY_LIB
-		    ?  get_int_kind_from_node (ptr_type_node)
+		    ? get_int_kind_from_node (ptr_type_node)
+		    : gfc_default_integer_kind, GFC_STD_F2008_TS)
+
+NAMED_DERIVED_TYPE (ISOFORTRAN_TEAM_TYPE, "team_type", \
+		    flag_coarray == GFC_FCOARRAY_LIB
+		    ? get_int_kind_from_node (ptr_type_node)
 		    : gfc_default_integer_kind, GFC_STD_F2008_TS)
 
 #undef NAMED_INTCST
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 006ac0312ac..9172b1a25fb 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -1592,16 +1592,19 @@ gfc_match_if (gfc_statement *if_type)
   match ("assign", gfc_match_assign, ST_LABEL_ASSIGNMENT)
   match ("backspace", gfc_match_backspace, ST_BACKSPACE)
   match ("call", gfc_match_call, ST_CALL)
+  match ("change team", gfc_match_change_team, ST_CHANGE_TEAM)
   match ("close", gfc_match_close, ST_CLOSE)
   match ("continue", gfc_match_continue, ST_CONTINUE)
   match ("cycle", gfc_match_cycle, ST_CYCLE)
   match ("deallocate", gfc_match_deallocate, ST_DEALLOCATE)
   match ("end file", gfc_match_endfile, ST_END_FILE)
+  match ("end team", gfc_match_end_team, ST_END_TEAM)
   match ("error stop", gfc_match_error_stop, ST_ERROR_STOP)
   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 ("form team", gfc_match_form_team, ST_FORM_TEAM)
   match ("flush", gfc_match_flush, ST_FLUSH)
   match ("forall", match_simple_forall, ST_FORALL)
   match ("go to", gfc_match_goto, ST_GOTO)
@@ -1617,6 +1620,7 @@ gfc_match_if (gfc_statement *if_type)
   match ("rewind", gfc_match_rewind, ST_REWIND)
   match ("stop", gfc_match_stop, ST_STOP)
   match ("wait", gfc_match_wait, ST_WAIT)
+  match ("sync team", gfc_match_sync_team, ST_SYNC_TEAM)
   match ("sync all", gfc_match_sync_all, ST_SYNC_CALL);
   match ("sync images", gfc_match_sync_images, ST_SYNC_IMAGES);
   match ("sync memory", gfc_match_sync_memory, ST_SYNC_MEMORY);
@@ -1656,7 +1660,6 @@ got_match:
       gfc_free_expr (expr);
       return MATCH_ERROR;
     }
-
   /* At this point, we've matched the single IF and the action clause
      is in new_st.  Rearrange things so that the IF statement appears
      in new_st.  */
@@ -3287,6 +3290,136 @@ syntax:
   return MATCH_ERROR;
 }
 
+/* Match a FORM TEAM statement.  */
+
+match
+gfc_match_form_team (void)
+{
+  match m;
+  gfc_expr *teamid,*team;
+
+  if (!gfc_notify_std (GFC_STD_F2008_TS, "FORM TEAM statement at %C"))
+    return MATCH_ERROR;
+
+  if (gfc_match_char ('(') == MATCH_NO)
+    goto syntax;
+  
+  new_st.op = EXEC_FORM_TEAM;
+
+  if (gfc_match ("%e", &teamid) != MATCH_YES)
+    goto syntax;
+  m = gfc_match_char (',');
+  if (m == MATCH_ERROR)
+    goto syntax;
+  if (gfc_match ("%e", &team) != MATCH_YES)
+    goto syntax;
+
+  m = gfc_match_char (')');
+  if (m == MATCH_NO)
+    goto syntax;
+
+  new_st.expr1 = teamid;
+  new_st.expr2 = team;
+
+  return MATCH_YES;
+
+syntax:
+  gfc_syntax_error (ST_FORM_TEAM);
+
+  return MATCH_ERROR;
+}
+
+/* Match a CHANGE TEAM statement.  */
+
+match
+gfc_match_change_team (void)
+{
+  match m;
+  gfc_expr *team;
+
+  if (!gfc_notify_std (GFC_STD_F2008_TS, "CHANGE TEAM statement at %C"))
+    return MATCH_ERROR;
+
+  if (gfc_match_char ('(') == MATCH_NO)
+    goto syntax;
+  
+  new_st.op = EXEC_CHANGE_TEAM;
+
+  /* if (gfc_match ("%e", &teamid) != MATCH_YES) */
+  /*   goto syntax; */
+  /* m = gfc_match_char (','); */
+  /* if (m == MATCH_ERROR) */
+  /*   goto syntax; */
+  if (gfc_match ("%e", &team) != MATCH_YES)
+    goto syntax;
+
+  m = gfc_match_char (')');
+  if (m == MATCH_NO)
+    goto syntax;
+
+  new_st.expr1 = team;
+
+  return MATCH_YES;
+
+syntax:
+  gfc_syntax_error (ST_CHANGE_TEAM);
+
+  return MATCH_ERROR;
+}
+
+/* Match a END TEAM statement.  */
+
+match
+gfc_match_end_team (void)
+{
+  if (!gfc_notify_std (GFC_STD_F2008_TS, "END TEAM statement at %C"))
+    return MATCH_ERROR;
+
+  if (gfc_match_char ('(') == MATCH_YES)
+    goto syntax;
+  
+  new_st.op = EXEC_END_TEAM;
+
+  return MATCH_YES;
+
+syntax:
+  gfc_syntax_error (ST_END_TEAM);
+
+  return MATCH_ERROR;
+}
+
+/* Match a SYNC TEAM statement.  */
+
+match
+gfc_match_sync_team (void)
+{
+  match m;
+  gfc_expr *team;
+
+  if (!gfc_notify_std (GFC_STD_F2008_TS, "SYNC TEAM statement at %C"))
+    return MATCH_ERROR;
+
+  if (gfc_match_char ('(') == MATCH_NO)
+    goto syntax;
+  
+  new_st.op = EXEC_SYNC_TEAM;
+
+  if (gfc_match ("%e", &team) != MATCH_YES)
+    goto syntax;
+
+  m = gfc_match_char (')');
+  if (m == MATCH_NO)
+    goto syntax;
+
+  new_st.expr1 = team;
+
+  return MATCH_YES;
+
+syntax:
+  gfc_syntax_error (ST_SYNC_TEAM);
+
+  return MATCH_ERROR;
+}
 
 /* Match LOCK/UNLOCK statement. Syntax:
      LOCK ( lock-variable [ , lock-stat-list ] )
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index 64f2038f032..3ba3b717fa3 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -74,6 +74,10 @@ match gfc_match_event_post (void);
 match gfc_match_event_wait (void);
 match gfc_match_critical (void);
 match gfc_match_fail_image (void);
+match gfc_match_change_team (void);
+match gfc_match_end_team (void);
+match gfc_match_form_team (void);
+match gfc_match_sync_team (void);
 match gfc_match_block (void);
 match gfc_match_associate (void);
 match gfc_match_do (void);
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 305a036a71e..7f1400ba36c 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -451,6 +451,7 @@ decode_statement (void)
 
     case 'c':
       match ("call", gfc_match_call, ST_CALL);
+      match ("change team", gfc_match_change_team, ST_CHANGE_TEAM);
       match ("close", gfc_match_close, ST_CLOSE);
       match ("continue", gfc_match_continue, ST_CONTINUE);
       match ("contiguous", gfc_match_contiguous, ST_ATTR_DECL);
@@ -470,6 +471,7 @@ decode_statement (void)
 
     case 'e':
       match ("end file", gfc_match_endfile, ST_END_FILE);
+      match ("end team", gfc_match_end_team, ST_END_TEAM);
       match ("exit", gfc_match_exit, ST_EXIT);
       match ("else", gfc_match_else, ST_ELSE);
       match ("else where", gfc_match_elsewhere, ST_ELSEWHERE);
@@ -491,6 +493,7 @@ decode_statement (void)
       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 ("form team", gfc_match_form_team, ST_FORM_TEAM);
       match ("format", gfc_match_format, ST_FORMAT);
       break;
 
@@ -558,6 +561,7 @@ decode_statement (void)
       match ("sync all", gfc_match_sync_all, ST_SYNC_ALL);
       match ("sync images", gfc_match_sync_images, ST_SYNC_IMAGES);
       match ("sync memory", gfc_match_sync_memory, ST_SYNC_MEMORY);
+      match ("sync team", gfc_match_sync_team, ST_SYNC_TEAM);
       break;
 
     case 't':
@@ -587,7 +591,7 @@ decode_statement (void)
 
   if (!gfc_error_check ())
     gfc_error_now ("Unclassifiable statement at %C");
-
+  
   reject_statement ();
 
   gfc_error_recovery ();
@@ -1499,7 +1503,10 @@ next_statement (void)
   case ST_OMP_TARGET_UPDATE: case ST_OMP_TARGET_ENTER_DATA: \
   case ST_OMP_TARGET_EXIT_DATA: case ST_OMP_ORDERED_DEPEND: \
   case ST_ERROR_STOP: case ST_SYNC_ALL: \
-  case ST_SYNC_IMAGES: case ST_SYNC_MEMORY: case ST_LOCK: case ST_UNLOCK: \
+  case ST_SYNC_IMAGES: case ST_SYNC_MEMORY: \
+  case ST_LOCK: case ST_UNLOCK: \
+  case ST_FORM_TEAM: case ST_CHANGE_TEAM: \
+  case ST_END_TEAM: case ST_SYNC_TEAM: \
   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
@@ -1831,6 +1838,18 @@ gfc_ascii_statement (gfc_statement st)
     case ST_FAIL_IMAGE:
       p = "FAIL IMAGE";
       break;
+    case ST_CHANGE_TEAM:
+      p = "CHANGE TEAM";
+      break;
+    case ST_END_TEAM:
+      p = "END TEAM";
+      break;
+    case ST_FORM_TEAM:
+      p = "FORM TEAM";
+      break;
+    case ST_SYNC_TEAM:
+      p = "SYNC TEAM";
+      break;
     case ST_END_ASSOCIATE:
       p = "END ASSOCIATE";
       break;
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 5caf76761ee..20efebab309 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -10887,6 +10887,18 @@ start:
 	case EXEC_FAIL_IMAGE:
 	  break;
 
+	case EXEC_FORM_TEAM:
+	  break;
+	  
+	case EXEC_CHANGE_TEAM:
+	  break;
+	  
+	case EXEC_END_TEAM:
+	  break;
+
+	case EXEC_SYNC_TEAM:
+	  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 169aef1d892..17d77e9a6c6 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -2495,6 +2495,28 @@ gfc_simplify_failed_or_stopped_images (gfc_expr *team ATTRIBUTE_UNUSED,
   return NULL;
 }
 
+gfc_expr *
+gfc_simplify_get_team (gfc_expr *level ATTRIBUTE_UNUSED)
+{
+  if (flag_coarray == GFC_FCOARRAY_NONE)
+    {
+      gfc_current_locus = *gfc_current_intrinsic_where;
+      gfc_fatal_error ("Coarrays disabled at %C, use %<-fcoarray=%> to enable");
+      return &gfc_bad_expr;
+    }
+
+  if (flag_coarray == GFC_FCOARRAY_SINGLE)
+    {
+      gfc_expr *result;
+      result = gfc_get_array_expr (BT_INTEGER, gfc_default_integer_kind, &gfc_current_locus);
+      result->rank = 0;
+      return result;
+    }
+
+  /* For fcoarray = lib no simplification is possible, because it is not known
+     what images failed or are stopped at compile time.  */
+  return NULL;
+}
 
 gfc_expr *
 gfc_simplify_float (gfc_expr *a)
diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c
index bffe50df7b8..a2699b7a074 100644
--- a/gcc/fortran/st.c
+++ b/gcc/fortran/st.c
@@ -121,6 +121,10 @@ gfc_free_statement (gfc_code *p)
     case EXEC_EVENT_POST:
     case EXEC_EVENT_WAIT:
     case EXEC_FAIL_IMAGE:
+    case EXEC_CHANGE_TEAM:
+    case EXEC_END_TEAM:
+    case EXEC_FORM_TEAM:
+    case EXEC_SYNC_TEAM:
       break;
 
     case EXEC_BLOCK:
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 74d860689ee..1464f5ebf10 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -157,6 +157,11 @@ tree gfor_fndecl_caf_fail_image;
 tree gfor_fndecl_caf_failed_images;
 tree gfor_fndecl_caf_image_status;
 tree gfor_fndecl_caf_stopped_images;
+tree gfor_fndecl_caf_form_team;
+tree gfor_fndecl_caf_change_team;
+tree gfor_fndecl_caf_end_team;
+tree gfor_fndecl_caf_sync_team;
+tree gfor_fndecl_caf_get_team;
 tree gfor_fndecl_co_broadcast;
 tree gfor_fndecl_co_max;
 tree gfor_fndecl_co_min;
@@ -3620,10 +3625,10 @@ gfc_build_builtin_function_decls (void)
 	boolean_type_node, pint_type);
 
       gfor_fndecl_caf_send = gfc_build_library_function_decl_with_spec (
-	get_identifier (PREFIX("caf_send")), ".R.RRRRRRW", void_type_node, 10,
+	get_identifier (PREFIX("caf_send")), ".R.RRRRRRWR", void_type_node, 11,
 	pvoid_type_node, size_type_node, integer_type_node, pvoid_type_node,
 	pvoid_type_node, pvoid_type_node, integer_type_node, integer_type_node,
-	boolean_type_node, pint_type);
+	boolean_type_node, pint_type, pvoid_type_node);
 
       gfor_fndecl_caf_sendget = gfc_build_library_function_decl_with_spec (
 	get_identifier (PREFIX("caf_sendget")), ".R.RRRR.RRRRRR",
@@ -3747,6 +3752,33 @@ gfc_build_builtin_function_decls (void)
 	    void_type_node, 3, pvoid_type_node, ppvoid_type_node,
 	    integer_type_node);
 
+      gfor_fndecl_caf_form_team
+	= gfc_build_library_function_decl_with_spec (
+	    get_identifier (PREFIX("caf_form_team")), "RWR",
+	    void_type_node, 3, integer_type_node, ppvoid_type_node,
+	    integer_type_node);
+
+      gfor_fndecl_caf_change_team
+	= gfc_build_library_function_decl_with_spec (
+	    get_identifier (PREFIX("caf_change_team")), "RR",
+	    void_type_node, 2, ppvoid_type_node,
+	    integer_type_node);
+
+      gfor_fndecl_caf_end_team
+	= gfc_build_library_function_decl (
+	    get_identifier (PREFIX("caf_end_team")), void_type_node, 0);
+
+      gfor_fndecl_caf_get_team
+	= gfc_build_library_function_decl_with_spec (
+	    get_identifier (PREFIX("caf_get_team")), "R",
+	    void_type_node, 1, integer_type_node);
+
+      gfor_fndecl_caf_sync_team
+	= gfc_build_library_function_decl_with_spec (
+	    get_identifier (PREFIX("caf_sync_team")), "RR",
+	    void_type_node, 2, ppvoid_type_node,
+	    integer_type_node);
+      
       gfor_fndecl_caf_image_status
 	= gfc_build_library_function_decl_with_spec (
 	    get_identifier (PREFIX("caf_image_status")), "RR",
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 3c9e1d5e037..37ae74390a7 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -842,6 +842,7 @@ gfc_conv_intrinsic_lib_function (gfc_se * se, gfc_expr * expr)
   gfc_isym_id id;
 
   id = expr->value.function.isym->id;
+
   /* Find the entry for this function.  */
   for (m = gfc_intrinsic_map;
        m->id != GFC_ISYM_NONE || m->double_built_in != END_BUILTINS; m++)
@@ -852,6 +853,7 @@ gfc_conv_intrinsic_lib_function (gfc_se * se, gfc_expr * expr)
 
   if (m->id == GFC_ISYM_NONE)
     {
+      printf("Id %d none %d\n",id,GFC_ISYM_NONE);
       gfc_internal_error ("Intrinsic function %qs (%d) not recognized",
 			  expr->value.function.name, id);
     }
@@ -1847,11 +1849,11 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind,
 
 static tree
 conv_caf_send (gfc_code *code) {
-  gfc_expr *lhs_expr, *rhs_expr, *tmp_stat;
+  gfc_expr *lhs_expr, *rhs_expr, *tmp_stat, *tmp_team;
   gfc_se lhs_se, rhs_se;
   stmtblock_t block;
   tree caf_decl, token, offset, image_index, tmp, lhs_kind, rhs_kind;
-  tree may_require_tmp, src_stat, dst_stat;
+  tree may_require_tmp, src_stat, dst_stat, dst_team, src_team;
   tree lhs_type = NULL_TREE;
   tree vec = null_pointer_node, rhs_vec = null_pointer_node;
   symbol_attribute lhs_caf_attr, rhs_caf_attr;
@@ -1867,6 +1869,7 @@ conv_caf_send (gfc_code *code) {
   lhs_caf_attr = gfc_caf_attr (lhs_expr);
   rhs_caf_attr = gfc_caf_attr (rhs_expr);
   src_stat = dst_stat = null_pointer_node;
+  src_team = dst_team = null_pointer_node;
 
   /* LHS.  */
   gfc_init_se (&lhs_se, NULL);
@@ -2069,6 +2072,18 @@ conv_caf_send (gfc_code *code) {
       gfc_add_block_to_block (&block, &stat_se.post);
     }
 
+  tmp_team = gfc_find_team_co (lhs_expr);
+
+  if (tmp_team)
+    {
+      gfc_se team_se;
+      gfc_init_se (&team_se, NULL);
+      gfc_conv_expr_reference (&team_se, tmp_team);
+      dst_team = team_se.expr;
+      gfc_add_block_to_block (&block, &team_se.pre);
+      gfc_add_block_to_block (&block, &team_se.post);
+    }
+
   if (!gfc_is_coindexed (rhs_expr))
     {
       if (lhs_caf_attr.alloc_comp || lhs_caf_attr.pointer_comp)
@@ -2084,10 +2099,10 @@ conv_caf_send (gfc_code *code) {
 				     may_require_tmp, dst_realloc, src_stat);
 	  }
       else
-	tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_send, 10,
+	tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_send, 11,
 				   token, offset, image_index, lhs_se.expr, vec,
 				   rhs_se.expr, lhs_kind, rhs_kind,
-				   may_require_tmp, src_stat);
+				   may_require_tmp, src_stat, dst_team);
     }
   else
     {
@@ -9500,6 +9515,7 @@ gfc_is_intrinsic_libcall (gfc_expr * expr)
 
     case GFC_ISYM_CSHIFT:
     case GFC_ISYM_EOSHIFT:
+    case GFC_ISYM_GET_TEAM:
     case GFC_ISYM_FAILED_IMAGES:
     case GFC_ISYM_STOPPED_IMAGES:
     case GFC_ISYM_PACK:
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index a1e1dff72e0..35674843beb 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -696,6 +696,115 @@ gfc_trans_fail_image (gfc_code *code ATTRIBUTE_UNUSED)
     }
 }
 
+/* Translate the FORM TEAM statement.  */
+
+tree
+gfc_trans_form_team (gfc_code *code)
+{
+  if (flag_coarray == GFC_FCOARRAY_LIB)
+    {
+      gfc_se argse;
+      tree team_id,team_type;
+      gfc_init_se (&argse, NULL);
+      gfc_conv_expr_val (&argse, code->expr1);
+      team_id = fold_convert (integer_type_node, argse.expr);
+      gfc_init_se (&argse, NULL);
+      gfc_conv_expr_val (&argse, code->expr2);
+      team_type = gfc_build_addr_expr (ppvoid_type_node, argse.expr);
+
+      return build_call_expr_loc (input_location,
+				  gfor_fndecl_caf_form_team, 3,
+				  team_id, team_type,
+				  build_int_cst (integer_type_node, 0));
+    }
+  else
+    {
+      const char *name = gfc_get_string (PREFIX ("exit_i%d"), 4);
+      gfc_symbol *exsym = gfc_get_intrinsic_sub_symbol (name);
+      tree tmp = gfc_get_symbol_decl (exsym);
+      return build_call_expr_loc (input_location, tmp, 1, integer_zero_node);
+    }
+}
+
+/* Translate the CHANGE TEAM statement.  */
+
+tree
+gfc_trans_change_team (gfc_code *code)
+{
+  if (flag_coarray == GFC_FCOARRAY_LIB)
+    {
+      gfc_se argse;
+      tree team_type;
+      /* gfc_init_se (&argse, NULL); */
+      /* gfc_conv_expr_val (&argse, code->expr1); */
+      /* team_id = fold_convert (integer_type_node, argse.expr); */
+      gfc_init_se (&argse, NULL);
+      gfc_conv_expr_val (&argse, code->expr1);
+      team_type = gfc_build_addr_expr (ppvoid_type_node, argse.expr);
+
+      return build_call_expr_loc (input_location,
+				  gfor_fndecl_caf_change_team, 2,
+				  team_type,
+				  build_int_cst (integer_type_node, 0));
+    }
+  else
+    {
+      const char *name = gfc_get_string (PREFIX ("exit_i%d"), 4);
+      gfc_symbol *exsym = gfc_get_intrinsic_sub_symbol (name);
+      tree tmp = gfc_get_symbol_decl (exsym);
+      return build_call_expr_loc (input_location, tmp, 1, integer_zero_node);
+    }
+}
+
+/* Translate the END TEAM statement.  */
+
+tree
+gfc_trans_end_team (gfc_code *code ATTRIBUTE_UNUSED)
+{
+  if (flag_coarray == GFC_FCOARRAY_LIB)
+    {
+      return build_call_expr_loc (input_location,
+				  gfor_fndecl_caf_end_team, 1,
+				  build_int_cst (pchar_type_node, 0));
+    }
+  else
+    {
+      const char *name = gfc_get_string (PREFIX ("exit_i%d"), 4);
+      gfc_symbol *exsym = gfc_get_intrinsic_sub_symbol (name);
+      tree tmp = gfc_get_symbol_decl (exsym);
+      return build_call_expr_loc (input_location, tmp, 1, integer_zero_node);
+    }
+}
+
+/* Translate the SYNC TEAM statement.  */
+
+tree
+gfc_trans_sync_team (gfc_code *code)
+{
+  if (flag_coarray == GFC_FCOARRAY_LIB)
+    {
+      gfc_se argse;
+      tree team_type;
+      /* gfc_init_se (&argse, NULL); */
+      /* gfc_conv_expr_val (&argse, code->expr1); */
+      /* team_id = fold_convert (integer_type_node, argse.expr); */
+      gfc_init_se (&argse, NULL);
+      gfc_conv_expr_val (&argse, code->expr1);
+      team_type = gfc_build_addr_expr (ppvoid_type_node, argse.expr);
+
+      return build_call_expr_loc (input_location,
+				  gfor_fndecl_caf_sync_team, 2,
+				  team_type,
+				  build_int_cst (integer_type_node, 0));
+    }
+  else
+    {
+      const char *name = gfc_get_string (PREFIX ("exit_i%d"), 4);
+      gfc_symbol *exsym = gfc_get_intrinsic_sub_symbol (name);
+      tree tmp = gfc_get_symbol_decl (exsym);
+      return build_call_expr_loc (input_location, tmp, 1, integer_zero_node);
+    }
+}
 
 tree
 gfc_trans_lock_unlock (gfc_code *code, gfc_exec_op op)
diff --git a/gcc/fortran/trans-stmt.h b/gcc/fortran/trans-stmt.h
index 0a39e26c218..80858a74298 100644
--- a/gcc/fortran/trans-stmt.h
+++ b/gcc/fortran/trans-stmt.h
@@ -57,6 +57,10 @@ 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_form_team (gfc_code *);
+tree gfc_trans_change_team (gfc_code *);
+tree gfc_trans_end_team (gfc_code *);
+tree gfc_trans_sync_team (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-types.c b/gcc/fortran/trans-types.c
index 8617cd51a7c..a5d19dc8feb 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -2441,12 +2441,14 @@ gfc_get_derived_type (gfc_symbol * derived, int codimen)
       || (flag_coarray == GFC_FCOARRAY_LIB
 	  && derived->from_intmod == INTMOD_ISO_FORTRAN_ENV
 	  && (derived->intmod_sym_id == ISOFORTRAN_LOCK_TYPE
-	      || derived->intmod_sym_id == ISOFORTRAN_EVENT_TYPE)))
+	      || derived->intmod_sym_id == ISOFORTRAN_EVENT_TYPE
+	      || derived->intmod_sym_id == ISOFORTRAN_TEAM_TYPE)))
     return ptr_type_node;
 
   if (flag_coarray != GFC_FCOARRAY_LIB
       && derived->from_intmod == INTMOD_ISO_FORTRAN_ENV
-      && derived->intmod_sym_id == ISOFORTRAN_EVENT_TYPE)
+      && (derived->intmod_sym_id == ISOFORTRAN_EVENT_TYPE
+	  || derived->intmod_sym_id == ISOFORTRAN_TEAM_TYPE))
     return gfc_get_int_type (gfc_default_integer_kind);
 
   if (derived && derived->attr.flavor == FL_PROCEDURE
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index 8f0adde77e0..b395183fb45 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -1961,6 +1961,22 @@ trans_code (gfc_code * code, tree cond)
 	  res = gfc_trans_forall (code);
 	  break;
 
+	case EXEC_FORM_TEAM:
+	  res = gfc_trans_form_team (code);
+	  break;
+
+	case EXEC_CHANGE_TEAM:
+	  res = gfc_trans_change_team (code);
+	  break;
+
+	case EXEC_END_TEAM:
+	  res = gfc_trans_end_team (code);
+	  break;
+
+	case EXEC_SYNC_TEAM:
+	  res = gfc_trans_sync_team (code);
+	  break;
+
 	case EXEC_WHERE:
 	  res = gfc_trans_where (code);
 	  break;
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index d02f3470eeb..f0386e711d2 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -837,6 +837,11 @@ extern GTY(()) tree gfor_fndecl_caf_fail_image;
 extern GTY(()) tree gfor_fndecl_caf_failed_images;
 extern GTY(()) tree gfor_fndecl_caf_image_status;
 extern GTY(()) tree gfor_fndecl_caf_stopped_images;
+extern GTY(()) tree gfor_fndecl_caf_form_team;
+extern GTY(()) tree gfor_fndecl_caf_change_team;
+extern GTY(()) tree gfor_fndecl_caf_end_team;
+extern GTY(()) tree gfor_fndecl_caf_get_team;
+extern GTY(()) tree gfor_fndecl_caf_sync_team;
 extern GTY(()) tree gfor_fndecl_co_broadcast;
 extern GTY(()) tree gfor_fndecl_co_max;
 extern GTY(()) tree gfor_fndecl_co_min;
-- 
2.11.0 (Apple Git-81)


[-- Attachment #3: team-number.f90 --]
[-- Type: application/octet-stream, Size: 895 bytes --]

program main
  !! Test team_number intrinsic function
  use iso_fortran_env, only : team_type
  use opencoarrays, only : team_number
  use assertions_module, only : assertions
  implicit none

  integer, parameter :: standard_initial_value=-1
  type(team_type), target :: home

  call assert(team_number()==standard_initial_value,"initial team number conforms with Fortran standard before 'change team'")

  associate(my_team=>mod(this_image(),2)+1)
    form team(my_team,home)
      !! Create two-team mapping: my_team=1 for even image numbers in the initial team; 2 for odd image numbers
    change team(home)
      call assert(team_number()==my_team,"team number maps to desired team after 'change team'")
    end team
    call assert(team_number()==standard_initial_value,"returned to the initial team")
  end associate

  sync all
  if (this_image()==1) print *,"Test passed."

end program

[-- Attachment #4: get-communicator.f90 --]
[-- Type: application/octet-stream, Size: 2973 bytes --]

module assertions_module
  implicit none
contains
  elemental subroutine assert(assertion,description)
    logical, intent(in) :: assertion
    character(len=*), intent(in) :: description
    integer, parameter :: max_digits=12
    character(len=max_digits) :: image_number
    if (.not.assertion) then
      write(image_number,*) this_image()
      error stop "Assertion '" // description // "' failed on image " // trim(image_number)
    end if
  end subroutine
end module

program main
  !! summary: Test get_communicator function, an OpenCoarrays-specific language extension
  use opencoarrays, only : get_communicator
  use assertions_module, only : assert
  implicit none

  call mpi_matches_caf(get_communicator())
    !! verify # ranks = # images and image number = rank + 1
  block
    use iso_fortran_env, only : team_type
    use opencoarrays, only : get_communicator, team_number !! TODO: remove team_number once gfortran supports it
    type(team_type) :: league
    integer, parameter :: num_teams=2
      !! number of child teams to form from the parent initial team
    associate(initial_image=>this_image(), initial_num_images=>num_images(), chosen_team=>destination_team(this_image(),num_teams))
      form team(chosen_team,league)
        !! map images to num_teams teams
      change team(league)
        !! join my destination team
        call mpi_matches_caf(get_communicator())
          !! verify new # ranks = new # images and new image number = new rank + 1
        associate(my_team=>team_number())
          call assert(my_team==chosen_team,"assigned team matches chosen team")
          associate(new_num_images=>initial_num_images/num_teams+merge(1,0,my_team<=mod(initial_num_images,num_teams)))
           call assert(num_images()==new_num_images,"block distribution of images")
          end associate
        end associate
      end team
      call assert( initial_image==this_image(),"correctly remapped to original image number")
      call assert( initial_num_images==num_images(),"correctly remapped to original number of images")
    end associate
  end block
  sync all
  if (this_image()==1) print *,"Test passed."
contains
   pure function destination_team(image,numTeams) result(team)
     integer, intent(in) ::image, numTeams
     integer ::team
     team = mod(image+1,numTeams)+1
   end function

  subroutine mpi_matches_caf(comm)
    use iso_c_binding, only : c_int
    use mpi, only : MPI_COMM_SIZE, MPI_COMM_RANK
    integer(c_int), intent(in) :: comm
      !! MPI communicator
    integer(c_int) :: isize,ierror,irank
    call MPI_COMM_SIZE(comm, isize, ierror)
    call assert( ierror==0 , "successful call MPI_COMM_SIZE" )
    call assert( isize==num_images(), "num MPI ranks = num CAF images " )
    call MPI_COMM_RANK(comm, irank, ierror)
    call assert( ierror==0 , "successful call MPI_COMM_RANK" )
    call assert( irank==this_image()-1 , "correct rank/image-number correspondence" )
  end subroutine
end program

Re: Draft patch: Fortran 2015 teams support and extension

[Damian Rouson]

**PING**

Soren has arrived at Cranfield University to begin his Ph.D. studies on work that is expected to include further development of the Fortran 2015 teams feature. If anyone is available to review the patch sent on September 12, please let us know.  If so desired, I can provide some funding for the review.

Damian

On September 12, 2017 at 2:24:10 PM, Damian Rouson (damian@sourceryinstitute.org) wrote:

All,  

With Alessandro’s approval, I’m submitting the attached draft patch showing his edits for supporting Fortran 2015 teams, which in my estimation is the one remaining big piece of Fortran 2015 missing from gfortran.  The patch also adds an extension: a get_communicator function that returns an MPI communicator if libcaf_mpi is the linked ABI.  There are known issues with the team_number function, but it works for the attached tests. I believe Alessandro might have time to work on team_number in a couple of weeks.  Also, there are known issues with teams that contain failed images.  I’m hopeful that entering Cranfield University Ph.D. student Soren Rasmussen will work on the interaction with failed images as a much longer-term project that will not make it into this patch.    

I’m submitting this now to request a review that will give us early guidance regarding the necessary steps for this patch to be approved for committing to the trunk.  I’ve also created a pull request on GitHub that provides a graphical interface to all the changes and allows for adding comments, including comments tied to specific lines:  

https://github.com/gcc-mirror/gcc/pull/14  

It would be great if review comments could be inserted at the above URL (click the Commits tab and then the first commit), but replies to this email are also welcome.  To test this patch, build the opencoarrays-teams branch of OpenCoarrays and the teams branch of the following fork of the GCC git mirror: https://github.com/sourceryinstitute/gcc.  

I have not created a ChangeLog but would be glad to do so if someone can explain the process unless that’s too preliminary at this stage.  


Damian  

Re: Draft patch: Fortran 2015 teams support and extension

[Paul Richard Thomas]

Hi Damian and Sandro,

I have taken a look at the patch. Please remove the commented out
sections, eg. in gfc_match_change_team. Apart from that, the patch is
ready for submission.

Is that testcase sufficient? I am asking because I don't know.

Cheers

Paul


On 27 September 2017 at 18:45, Damian Rouson
<damian@sourceryinstitute.org> wrote:
> **PING**
>
> Soren has arrived at Cranfield University to begin his Ph.D. studies on work that is expected to include further development of the Fortran 2015 teams feature. If anyone is available to review the patch sent on September 12, please let us know.  If so desired, I can provide some funding for the review.
>
> Damian
>
> On September 12, 2017 at 2:24:10 PM, Damian Rouson (damian@sourceryinstitute.org) wrote:
>
> All,
>
> With Alessandro’s approval, I’m submitting the attached draft patch showing his edits for supporting Fortran 2015 teams, which in my estimation is the one remaining big piece of Fortran 2015 missing from gfortran.  The patch also adds an extension: a get_communicator function that returns an MPI communicator if libcaf_mpi is the linked ABI.  There are known issues with the team_number function, but it works for the attached tests. I believe Alessandro might have time to work on team_number in a couple of weeks.  Also, there are known issues with teams that contain failed images.  I’m hopeful that entering Cranfield University Ph.D. student Soren Rasmussen will work on the interaction with failed images as a much longer-term project that will not make it into this patch.
>
> I’m submitting this now to request a review that will give us early guidance regarding the necessary steps for this patch to be approved for committing to the trunk.  I’ve also created a pull request on GitHub that provides a graphical interface to all the changes and allows for adding comments, including comments tied to specific lines:
>
> https://github.com/gcc-mirror/gcc/pull/14
>
> It would be great if review comments could be inserted at the above URL (click the Commits tab and then the first commit), but replies to this email are also welcome.  To test this patch, build the opencoarrays-teams branch of OpenCoarrays and the teams branch of the following fork of the GCC git mirror: https://github.com/sourceryinstitute/gcc.
>
> I have not created a ChangeLog but would be glad to do so if someone can explain the process unless that’s too preliminary at this stage.
>
>
> Damian
>
>



-- 
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein

Re: Draft patch: Fortran 2015 teams support and extension

[Jerry DeLisle]

On 09/28/2017 06:32 AM, Paul Richard Thomas wrote:
> Hi Damian and Sandro,
> 
> I have taken a look at the patch. Please remove the commented out
> sections, eg. in gfc_match_change_team. Apart from that, the patch is
> ready for submission.
> 
> Is that testcase sufficient? I am asking because I don't know.
> 
> Cheers
> 
> Paul
> 

I assume this has all been regression tested with our current testsuite. Are all
features tested in test cases?

Jerry

Re: Draft patch: Fortran 2015 teams support and extension

[Damian Rouson]

Hi Jerry,

I’ll be glad to run the regression tests if you can provide instructions on how to do so.  On a related note, upon completion of the work on integrating MPICH and OpenCoarrays into the GCC build scripts, it would be a good idea to add the OpenCoarrays unit tests to the GCC test suite.

On October 6, 2017 at 10:15:03 PM, Jerry DeLisle (jvdelisle@charter.net) wrote:

On 09/28/2017 06:32 AM, Paul Richard Thomas wrote:  
> Hi Damian and Sandro,  
>  
> I have taken a look at the patch. Please remove the commented out  
> sections, eg. in gfc_match_change_team. Apart from that, the patch is  
> ready for submission.  
>  
> Is that testcase sufficient? I am asking because I don't know.  
>  
> Cheers  
>  
> Paul  
>  

I assume this has all been regression tested with our current testsuite. Are all  
features tested in test cases?  

Jerry  

Re: Draft patch: Fortran 2015 teams support and extension

[Paul Richard Thomas]

Hi Jerry,

The reason that I asked if the testcase was sufficient is that it
didn't seem to do anything other than to check the parsing. Shouldn't
it do something to establish that the teams actually work, well... ,
as teams?

Cheers

Paul

On 8 October 2017 at 01:07, Damian Rouson <damian@sourceryinstitute.org> wrote:
>
> Hi Jerry,
>
> I’ll be glad to run the regression tests if you can provide instructions on
> how to do so.  On a related note, upon completion of the work on integrating
> MPICH and OpenCoarrays into the GCC build scripts, it would be a good idea
> to add the OpenCoarrays unit tests to the GCC test suite.
>
>
> On October 6, 2017 at 10:15:03 PM, Jerry DeLisle (jvdelisle@charter.net)
> wrote:
>
> On 09/28/2017 06:32 AM, Paul Richard Thomas wrote:
>> Hi Damian and Sandro,
>>
>> I have taken a look at the patch. Please remove the commented out
>> sections, eg. in gfc_match_change_team. Apart from that, the patch is
>> ready for submission.
>>
>> Is that testcase sufficient? I am asking because I don't know.
>>
>> Cheers
>>
>> Paul
>>
>
> I assume this has all been regression tested with our current testsuite. Are
> all
> features tested in test cases?
>
> Jerry



-- 
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein

Re: Draft patch: Fortran 2015 teams support and extension

[Jerry DeLisle]

From the top of the build directory
>> >  
>>
>> I assume this has all been regression tested with our current testsuite. Are all
>> features tested in test cases?
>>
>> Jerry


From the top of the build directory do:

cd gcc

make -k -j4 check-fortran

assuming its all fortran only stuff. I usually run -j4 with quad core machines,
you can do fewer threads if you wish.

Jerry