[PATCH,Fortran][RFC] PR 87939, 87326 - STAT= and ERRMSG= specifiers in several image control statements; NEW_INDEX= specifier in FORM TEAM statement

[PATCH,Fortran][RFC] PR 87939, 87326 - STAT= and ERRMSG= specifiers in several image control statements; NEW_INDEX= specifier in FORM TEAM statement

[Nathan Weeks]

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

Hi all,

To facilitate more complete Fortran 2018 failed images support, I'm
particularly interested in interested in seeing PR 87939 eventually
resolved (i.e., allow STAT= and ERRMSG= specifiers in FORM TEAM,
CHANGE TEAM, SYNC TEAM, END TEAM, and CRITICAL statements). To get the
ball rolling (I realize that the boat has been missed for this kind of
change in GCC 9 trunk), I've attempted the following patch (which,
since it was convenient to do while modifying FORM TEAM-related code,
also adds the NEW_INDEX= specifier to the FORM TEAM statement as
desired in PR 87326).

This is the first gfortran patch I've attempted, and I certainly could
have made some noob mistakes, so verbose feedback would be
appreciated.

A few comments:

* In resolve.c, the newly-added functions that type check STAT= and
ERRMSG= arguments for FORM TEAM, CHANGE TEAM, and SYNC TEAM also add
(previously-absent) type checking for their TEAM_TYPE arguments. If
it's more appropriate, I could separate this change into its own PR.

* The existing -fcoarray=lib implementation of CRITICAL acquires a
LOCK on a lock variable on image 1 (in the current team). However, a
CRITICAL statement stat-value of STAT_FAILED_IMAGE (i.e., the image
that enter the CRITICAL construct failed) is analogous to the LOCK
stat-value of STAT_UNLOCKED_FAILED_IMAGE (i.e., the image that
acquired the lock failed---see section 11.6.11 (7 & 10) in Fortran
2018 draft N2146), whereas a LOCK STAT_FAILED_IMAGE means the image on
which the lock variable resides has failed (no analog in the CRITICAL
statement, which is oblivious to this underlying implementation). So
in addition to adding the stat value STAT_UNLOCKED_FAILED_IMAGE to
libgfortran.h & libcaf.h, I had CRITICAL swap a LOCK
STAT_UNLOCKED_FAILED_IMAGE for STAT_FAILED_IMAGE, and (perhaps
unimaginatively) a LOCK STAT_FAILED_IMAGE for
STAT_UNLOCKED_FAILED_IMAGE (which, while it has no defined meaning for
a CRITICAL statement, fits the definition of a "processor-dependent
value other than STAT_FAILED_IMAGE").

* A couple negative tests for syntax errors (coarray_critical_2.f90 &
team_end_2.f90) fail due to spurious "Error: Expecting END PROGRAM
statement at (1)" errors that are also emitted by gfortran 8.2.0 as
well.

Thanks,

--
Nathan

frontend:

2019-01-16  Nathan Weeks  <weeks@iastate.edu>

        PR fortran/87939
        PR fortran/87326
        * gfortran.h: Add an additional gfc_expr member to struct gfc_code.
        * libcaf.h: Add support for STAT_UNLOCKED_FAILED_IMAGE.
        * match.c (gfc_match_critical): Add STAT= and ERRMSG=.
        (gfc_match_change_team): Likewise.
        (gfc_match_end_team): Likewise.
        (gfc_match_sync_team): Likewise.
        (gfc_match_form_team): Add STAT=, ERRMSG=, and NEW_INDEX=.
        * resolve.c (resolve_form_team): New. Type check team-variable
argument in
        addition to new STAT= and ERRMSG= arguments.
        (resolve_change_sync_team): New. Adds type checking for team-value
        argument.
        (resolve_end_team): New.
        (resolve_critical): Add STAT= and ERRMSG=.
        * trans-decl.c (gfc_build_builtin_function_decls): Additional stat,
        errmsg, and errmsg_len arguments to _gfortran_caf_form_team(),
        _gfortran_caf_change_team(), _gfortran_caf_end_team(), and
        _gfortran_caf_sync_team(), and additional new_index argument to
        _gfortran_caf_form_team().
        * trans-stmt.c (gfc_trans_form_team): Support STAT=, ERRMSG=, and
        NEW_INDEX=.
        (gfc_trans_change_team): Support STAT= and ERRMSG=.
        (gfc_trans_end_team): Likewise.
        (gfc_trans_sync_team): Likewise.
        (gfc_trans_critical): Likewise. Also support assigning STAT_FAILED_IMAGE
        to a stat-variable.

libgfortran:

2019-01-16  Nathan Weeks  <weeks@iastate.edu>

        PR fortran/87939
        * libgfortran.h: Add support for STAT_UNLOCKED_FAILED_IMAGE

testsuite:

2019-01-16  Nathan Weeks  <weeks@iastate.edu>

        PR fortran/87939
        PR fortran/87326
        * gfortran.dg/coarray_critical_2.f90: New test
        * gfortran.dg/coarray_critical_3.f90: New test
        * gfortran.dg/coarray_critical_4.f90: New test
        * gfortran.dg/team_change_2.f90: New test
        * gfortran.dg/team_change_3.f90: New test
        * gfortran.dg/team_end_2.f90: New test
        * gfortran.dg/team_end_3.f90: New test
        * gfortran.dg/team_form_2.f90: New test
        * gfortran.dg/team_form_3.f90: New test
        * gfortran.dg/team_sync_1.f90: New test
        * gfortran.dg/team_sync_2.f90: New test

[-- Attachment #2: stat-errmsg-new_index.diff --]
[-- Type: application/octet-stream, Size: 43311 bytes --]

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index e7a9b6f5674..5fc661c0ef9 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2578,7 +2578,7 @@ typedef struct gfc_code
 
   gfc_st_label *here, *label1, *label2, *label3;
   gfc_symtree *symtree;
-  gfc_expr *expr1, *expr2, *expr3, *expr4;
+  gfc_expr *expr1, *expr2, *expr3, *expr4, *expr5;
   /* A name isn't sufficient to identify a subroutine, we need the actual
      symbol for the interface definition.
   const char *sub_name;  */
diff --git a/gcc/fortran/libgfortran.h b/gcc/fortran/libgfortran.h
index 581b2f529db..5fc8df67230 100644
--- a/gcc/fortran/libgfortran.h
+++ b/gcc/fortran/libgfortran.h
@@ -133,7 +133,8 @@ 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  = 6001
+  GFC_STAT_FAILED_IMAGE  = 6001,
+  GFC_STAT_UNLOCKED_FAILED_IMAGE = 6002
 }
 libgfortran_stat_codes;
 
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 9ff1c35b2a0..9b0b60a7335 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -1795,6 +1795,12 @@ match
 gfc_match_critical (void)
 {
   gfc_st_label *label = NULL;
+  match m;
+  gfc_expr *tmp, *stat, *errmsg;
+  bool saw_stat, saw_errmsg;
+
+  tmp = stat = errmsg = NULL;
+  saw_stat = saw_errmsg = false;
 
   if (gfc_match_label () == MATCH_ERROR)
     return MATCH_ERROR;
@@ -1805,12 +1811,62 @@ gfc_match_critical (void)
   if (gfc_match_st_label (&label) == MATCH_ERROR)
     return MATCH_ERROR;
 
-  if (gfc_match_eos () != MATCH_YES)
+  if (gfc_match_eos () == MATCH_YES)
+    goto done;
+
+  if (gfc_match_char ('(') != MATCH_YES)
+    goto syntax;
+
+  for (;;)
     {
-      gfc_syntax_error (ST_CRITICAL);
-      return MATCH_ERROR;
+      m = gfc_match (" stat = %v", &tmp);
+      if (m == MATCH_ERROR)
+	goto syntax;
+      if (m == MATCH_YES)
+	{
+	  if (saw_stat)
+	    {
+	      gfc_error ("Redundant STAT tag found at %L", &tmp->where);
+	      goto cleanup;
+	    }
+	  stat = tmp;
+	  saw_stat = true;
+
+	  if (gfc_match_char (',') == MATCH_YES)
+	    continue;
+
+	  tmp = NULL;
+	  break;
+	}
+
+      m = gfc_match (" errmsg = %v", &tmp);
+      if (m == MATCH_ERROR)
+	goto syntax;
+      if (m == MATCH_YES)
+	{
+	  if (saw_errmsg)
+	    {
+	      gfc_error ("Redundant ERRMSG tag found at %L", &tmp->where);
+	      goto cleanup;
+	    }
+	  errmsg = tmp;
+	  saw_errmsg = true;
+
+	  if (gfc_match_char (',') == MATCH_YES)
+	    continue;
+
+	  tmp = NULL;
+	  break;
+	}
+
+	break;
     }
 
+  if (gfc_match (" )%t") != MATCH_YES)
+    goto syntax;
+
+done:
+
   if (gfc_pure (NULL))
     {
       gfc_error ("Image control statement CRITICAL at %C in PURE procedure");
@@ -1843,12 +1899,27 @@ gfc_match_critical (void)
     }
 
   new_st.op = EXEC_CRITICAL;
+  new_st.expr1 = stat;
+  new_st.expr2 = errmsg;
 
   if (label != NULL
       && !gfc_reference_st_label (label, ST_LABEL_TARGET))
-    return MATCH_ERROR;
+    goto cleanup;
 
   return MATCH_YES;
+
+syntax:
+  gfc_syntax_error (ST_CRITICAL);
+
+cleanup:
+  if (stat != tmp)
+    gfc_free_expr (stat);
+  if (errmsg != tmp)
+    gfc_free_expr (errmsg);
+
+  gfc_free_expr (tmp);
+
+  return MATCH_ERROR;
 }
 
 
@@ -3386,7 +3457,11 @@ match
 gfc_match_form_team (void)
 {
   match m;
-  gfc_expr *teamid,*team;
+  gfc_expr *teamid, *team, *new_index, *stat, *errmsg, *tmp;
+  bool saw_new_index, saw_stat, saw_errmsg;
+
+  team = new_index = stat = errmsg = tmp = NULL;
+  saw_new_index = saw_stat = saw_errmsg = false;
 
   if (!gfc_notify_std (GFC_STD_F2018, "FORM TEAM statement at %C"))
     return MATCH_ERROR;
@@ -3404,18 +3479,117 @@ gfc_match_form_team (void)
   if (gfc_match ("%e", &team) != MATCH_YES)
     goto syntax;
 
-  m = gfc_match_char (')');
+  m = gfc_match_char (',');
+  if (m == MATCH_ERROR)
+    goto syntax;
   if (m == MATCH_NO)
+    {
+      m = gfc_match_char (')');
+      if (m == MATCH_YES)
+	goto done;
+      goto syntax;
+    }
+
+  for (;;)
+    {
+      m = gfc_match (" stat = %v", &tmp);
+      if (m == MATCH_ERROR)
+	goto syntax;
+      if (m == MATCH_YES)
+	{
+	  if (saw_stat)
+	    {
+	      gfc_error ("Redundant STAT tag found at %L", &tmp->where);
+	      goto cleanup;
+	    }
+	  stat = tmp;
+	  saw_stat = true;
+
+	  m = gfc_match_char (',');
+	  if (m == MATCH_YES)
+	    continue;
+
+	  tmp = NULL;
+	  break;
+	}
+
+      m = gfc_match (" errmsg = %v", &tmp);
+      if (m == MATCH_ERROR)
+	goto syntax;
+      if (m == MATCH_YES)
+	{
+	  if (saw_errmsg)
+	    {
+	      gfc_error ("Redundant ERRMSG tag found at %L", &tmp->where);
+	      goto cleanup;
+	    }
+	  errmsg = tmp;
+	  saw_errmsg = true;
+
+	  m = gfc_match_char (',');
+	  if (m == MATCH_YES)
+	    continue;
+
+	  tmp = NULL;
+	  break;
+	}
+
+      m = gfc_match (" new_index = %e", &tmp);
+      if (m == MATCH_ERROR)
+	goto syntax;
+      if (m == MATCH_YES)
+	{
+	  if (saw_new_index)
+	    {
+	      gfc_error ("Redundant NEW_INDEX tag found at %L",
+			 &tmp->where);
+	      goto cleanup;
+	    }
+	  new_index = tmp;
+	  saw_new_index = true;
+
+	  m = gfc_match_char (',');
+	  if (m == MATCH_YES)
+	    continue;
+
+	  tmp = NULL;
+	  break;
+	}
+
+      break;
+    }
+
+  if (m == MATCH_ERROR)
+    goto syntax;
+
+  if (gfc_match (" )%t") != MATCH_YES)
     goto syntax;
 
+done:
+
   new_st.expr1 = teamid;
   new_st.expr2 = team;
+  new_st.expr3 = new_index;
+  new_st.expr4 = stat;
+  new_st.expr5 = errmsg;
 
   return MATCH_YES;
 
 syntax:
   gfc_syntax_error (ST_FORM_TEAM);
 
+cleanup:
+  if (new_index != tmp)
+    gfc_free_expr (new_index);
+  if (stat != tmp)
+    gfc_free_expr (stat);
+  if (errmsg != tmp)
+    gfc_free_expr (errmsg);
+
+  gfc_free_expr (tmp);
+  gfc_free_expr (team);
+  gfc_free_expr (teamid);
+
   return MATCH_ERROR;
 }
 
@@ -3425,7 +3599,11 @@ match
 gfc_match_change_team (void)
 {
   match m;
-  gfc_expr *team;
+  gfc_expr *team, *stat, *errmsg, *tmp;
+  bool saw_stat, saw_errmsg;
+
+  tmp = team = stat = errmsg = NULL;
+  saw_stat = saw_errmsg = false;
 
   if (!gfc_notify_std (GFC_STD_F2018, "CHANGE TEAM statement at %C"))
     return MATCH_ERROR;
@@ -3438,17 +3616,85 @@ gfc_match_change_team (void)
   if (gfc_match ("%e", &team) != MATCH_YES)
     goto syntax;
 
-  m = gfc_match_char (')');
+  m = gfc_match_char (',');
+  if (m == MATCH_ERROR)
+    goto syntax;
   if (m == MATCH_NO)
+    {
+      m = gfc_match_char (')');
+      if (m == MATCH_YES)
+	goto done;
+      goto syntax;
+    }
+
+  for (;;)
+    {
+      m = gfc_match (" stat = %v", &tmp);
+      if (m == MATCH_ERROR)
+	goto syntax;
+      if (m == MATCH_YES)
+	{
+	  if (saw_stat)
+	    {
+	      gfc_error ("Redundant STAT tag found at %L", &tmp->where);
+	      goto cleanup;
+	    }
+	  stat = tmp;
+	  saw_stat = true;
+
+	  if (gfc_match_char (',') == MATCH_YES)
+	    continue;
+
+	  tmp = NULL;
+	  break;
+	}
+
+      m = gfc_match (" errmsg = %v", &tmp);
+      if (m == MATCH_ERROR)
+	goto syntax;
+      if (m == MATCH_YES)
+	{
+	  if (saw_errmsg)
+	    {
+	      gfc_error ("Redundant ERRMSG tag found at %L", &tmp->where);
+	      goto cleanup;
+	    }
+	  errmsg = tmp;
+	  saw_errmsg = true;
+
+	  if (gfc_match_char (',') == MATCH_YES)
+	    continue;
+
+	  tmp = NULL;
+	  break;
+	}
+
+	break;
+    }
+
+  if (gfc_match (" )%t") != MATCH_YES)
     goto syntax;
 
+done:
+
   new_st.expr1 = team;
+  new_st.expr2 = stat;
+  new_st.expr3 = errmsg;
 
   return MATCH_YES;
 
 syntax:
   gfc_syntax_error (ST_CHANGE_TEAM);
 
+cleanup:
+  if (stat != tmp)
+    gfc_free_expr (stat);
+  if (errmsg != tmp)
+    gfc_free_expr (errmsg);
+
+  gfc_free_expr (tmp);
+  gfc_free_expr (team);
+
   return MATCH_ERROR;
 }
 
@@ -3457,19 +3703,89 @@ syntax:
 match
 gfc_match_end_team (void)
 {
+  match m;
+  gfc_expr *tmp, *stat, *errmsg;
+  bool saw_stat, saw_errmsg;
+
+  tmp = stat = errmsg = NULL;
+  saw_stat = saw_errmsg = false;
+
   if (!gfc_notify_std (GFC_STD_F2018, "END TEAM statement at %C"))
     return MATCH_ERROR;
 
-  if (gfc_match_char ('(') == MATCH_YES)
+  if (gfc_match_eos () == MATCH_YES)
+    goto done;
+
+  if (gfc_match_char ('(') != MATCH_YES)
+    goto syntax;
+
+  for (;;)
+    {
+      m = gfc_match (" stat = %v", &tmp);
+      if (m == MATCH_ERROR)
+	goto syntax;
+      if (m == MATCH_YES)
+	{
+	  if (saw_stat)
+	    {
+	      gfc_error ("Redundant STAT tag found at %L", &tmp->where);
+	      goto cleanup;
+	    }
+	  stat = tmp;
+	  saw_stat = true;
+
+	  if (gfc_match_char (',') == MATCH_YES)
+	    continue;
+
+	  tmp = NULL;
+	  break;
+	}
+
+      m = gfc_match (" errmsg = %v", &tmp);
+      if (m == MATCH_ERROR)
+	goto syntax;
+      if (m == MATCH_YES)
+	{
+	  if (saw_errmsg)
+	    {
+	      gfc_error ("Redundant ERRMSG tag found at %L", &tmp->where);
+	      goto cleanup;
+	    }
+	  errmsg = tmp;
+	  saw_errmsg = true;
+
+	  if (gfc_match_char (',') == MATCH_YES)
+	    continue;
+
+	  tmp = NULL;
+	  break;
+	}
+
+	break;
+    }
+
+  if (gfc_match (" )%t") != MATCH_YES)
     goto syntax;
 
+done:
+
   new_st.op = EXEC_END_TEAM;
+  new_st.expr1 = stat;
+  new_st.expr2 = errmsg;
 
   return MATCH_YES;
 
 syntax:
   gfc_syntax_error (ST_END_TEAM);
 
+cleanup:
+  if (stat != tmp)
+    gfc_free_expr (stat);
+  if (errmsg != tmp)
+    gfc_free_expr (errmsg);
+
+  gfc_free_expr (tmp);
+
   return MATCH_ERROR;
 }
 
@@ -3479,7 +3795,11 @@ match
 gfc_match_sync_team (void)
 {
   match m;
-  gfc_expr *team;
+  gfc_expr *team, *stat, *errmsg, *tmp;
+  bool saw_stat, saw_errmsg;
+
+  tmp = team = stat = errmsg = NULL;
+  saw_stat = saw_errmsg = false;
 
   if (!gfc_notify_std (GFC_STD_F2018, "SYNC TEAM statement at %C"))
     return MATCH_ERROR;
@@ -3492,17 +3812,85 @@ gfc_match_sync_team (void)
   if (gfc_match ("%e", &team) != MATCH_YES)
     goto syntax;
 
-  m = gfc_match_char (')');
+  m = gfc_match_char (',');
+  if (m == MATCH_ERROR)
+    goto syntax;
   if (m == MATCH_NO)
+    {
+      m = gfc_match_char (')');
+      if (m == MATCH_YES)
+	goto done;
+      goto syntax;
+    }
+
+  for (;;)
+    {
+      m = gfc_match (" stat = %v", &tmp);
+      if (m == MATCH_ERROR)
+	goto syntax;
+      if (m == MATCH_YES)
+	{
+	  if (saw_stat)
+	    {
+	      gfc_error ("Redundant STAT tag found at %L", &tmp->where);
+	      goto cleanup;
+	    }
+	  stat = tmp;
+	  saw_stat = true;
+
+	  if (gfc_match_char (',') == MATCH_YES)
+	    continue;
+
+	  tmp = NULL;
+	  break;
+	}
+
+      m = gfc_match (" errmsg = %v", &tmp);
+      if (m == MATCH_ERROR)
+	goto syntax;
+      if (m == MATCH_YES)
+	{
+	  if (saw_errmsg)
+	    {
+	      gfc_error ("Redundant ERRMSG tag found at %L", &tmp->where);
+	      goto cleanup;
+	    }
+	  errmsg = tmp;
+	  saw_errmsg = true;
+
+	  if (gfc_match_char (',') == MATCH_YES)
+	    continue;
+
+	  tmp = NULL;
+	  break;
+	}
+
+	break;
+    }
+
+  if (gfc_match (" )%t") != MATCH_YES)
     goto syntax;
 
+done:
+
   new_st.expr1 = team;
+  new_st.expr2 = stat;
+  new_st.expr3 = errmsg;
 
   return MATCH_YES;
 
 syntax:
   gfc_syntax_error (ST_SYNC_TEAM);
 
+cleanup:
+  if (stat != tmp)
+    gfc_free_expr (stat);
+  if (errmsg != tmp)
+    gfc_free_expr (errmsg);
+
+  gfc_free_expr (tmp);
+  gfc_free_expr (team);
+
   return MATCH_ERROR;
 }
 
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index b1c92929003..8095fbfabca 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -9623,6 +9623,89 @@ resolve_lock_unlock_event (gfc_code *code)
     }
 }
 
+static void
+resolve_form_team (gfc_code *code)
+{
+  if (code->expr2->ts.type != BT_DERIVED
+	  || code->expr2->expr_type != EXPR_VARIABLE
+	  || code->expr2->ts.u.derived->from_intmod != INTMOD_ISO_FORTRAN_ENV
+	  || code->expr2->ts.u.derived->intmod_sym_id != ISOFORTRAN_TEAM_TYPE
+	  || code->expr2->rank != 0)
+    gfc_error ("Team variable at %L must be a scalar of type TEAM_TYPE",
+	       &code->expr2->where);
+
+  /* Check NEW_INDEX.  */
+  if (code->expr3)
+    {
+      if (!gfc_resolve_expr (code->expr3) || code->expr3->ts.type != BT_INTEGER
+	  || code->expr3->rank != 0)
+	gfc_error ("NEW_INDEX= argument at %L must be a scalar INTEGER "
+		   "expression", &code->expr3->where);
+    }
+
+  /* Check STAT.  */
+  gfc_resolve_expr (code->expr4);
+  if (code->expr4
+      && (code->expr4->ts.type != BT_INTEGER || code->expr4->rank != 0
+	  || code->expr4->expr_type != EXPR_VARIABLE))
+    gfc_error ("STAT= argument at %L must be a scalar INTEGER variable",
+	       &code->expr4->where);
+
+  /* Check ERRMSG.  */
+  gfc_resolve_expr (code->expr5);
+  if (code->expr5
+      && (code->expr5->ts.type != BT_CHARACTER || code->expr5->rank != 0
+	  || code->expr5->expr_type != EXPR_VARIABLE))
+    gfc_error ("ERRMSG= argument at %L must be a scalar CHARACTER variable",
+	       &code->expr5->where);
+}
+
+static void
+resolve_change_sync_team (gfc_code *code)
+{
+  if (code->expr1->ts.type != BT_DERIVED
+	  || code->expr1->ts.u.derived->from_intmod != INTMOD_ISO_FORTRAN_ENV
+	  || code->expr1->ts.u.derived->intmod_sym_id != ISOFORTRAN_TEAM_TYPE
+	  || code->expr1->rank != 0)
+    gfc_error ("team-value argument at %L must be a scalar TEAM_TYPE expression",
+	       &code->expr1->where);
+
+  /* Check STAT.  */
+  gfc_resolve_expr (code->expr2);
+  if (code->expr2
+      && (code->expr2->ts.type != BT_INTEGER || code->expr2->rank != 0
+	  || code->expr2->expr_type != EXPR_VARIABLE))
+    gfc_error ("STAT= argument at %L must be a scalar INTEGER variable",
+	       &code->expr2->where);
+
+  /* Check ERRMSG.  */
+  gfc_resolve_expr (code->expr3);
+  if (code->expr3
+      && (code->expr3->ts.type != BT_CHARACTER || code->expr3->rank != 0
+	  || code->expr3->expr_type != EXPR_VARIABLE))
+    gfc_error ("ERRMSG= argument at %L must be a scalar CHARACTER variable",
+	       &code->expr3->where);
+}
+
+static void
+resolve_end_team (gfc_code *code)
+{
+  /* Check STAT.  */
+  gfc_resolve_expr (code->expr1);
+  if (code->expr1
+      && (code->expr1->ts.type != BT_INTEGER || code->expr1->rank != 0
+	  || code->expr1->expr_type != EXPR_VARIABLE))
+    gfc_error ("STAT= argument at %L must be a scalar INTEGER variable",
+	       &code->expr1->where);
+
+  /* Check ERRMSG.  */
+  gfc_resolve_expr (code->expr2);
+  if (code->expr2
+      && (code->expr2->ts.type != BT_CHARACTER || code->expr2->rank != 0
+	  || code->expr2->expr_type != EXPR_VARIABLE))
+    gfc_error ("ERRMSG= argument at %L must be a scalar CHARACTER variable",
+	       &code->expr2->where);
+}
 
 static void
 resolve_critical (gfc_code *code)
@@ -9632,6 +9715,22 @@ resolve_critical (gfc_code *code)
   char name[GFC_MAX_SYMBOL_LEN];
   static int serial = 0;
 
+  /* Check STAT.  */
+  gfc_resolve_expr (code->expr1);
+  if (code->expr1
+      && (code->expr1->ts.type != BT_INTEGER || code->expr1->rank != 0
+	  || code->expr1->expr_type != EXPR_VARIABLE))
+    gfc_error ("STAT= argument at %L must be a scalar INTEGER variable",
+	       &code->expr1->where);
+
+  /* Check ERRMSG.  */
+  gfc_resolve_expr (code->expr2);
+  if (code->expr2
+      && (code->expr2->ts.type != BT_CHARACTER || code->expr2->rank != 0
+	  || code->expr2->expr_type != EXPR_VARIABLE))
+    gfc_error ("ERRMSG= argument at %L must be a scalar CHARACTER variable",
+	       &code->expr2->where);
+
   if (flag_coarray != GFC_FCOARRAY_LIB)
     return;
 
@@ -11324,10 +11423,18 @@ start:
 	  break;
 
 	case EXEC_FAIL_IMAGE:
+      break;
 	case EXEC_FORM_TEAM:
+      resolve_form_team (code);
+      break;
+
 	case EXEC_CHANGE_TEAM:
-	case EXEC_END_TEAM:
 	case EXEC_SYNC_TEAM:
+      resolve_change_sync_team (code);
+      break;
+
+	case EXEC_END_TEAM:
+      resolve_end_team (code);
 	  break;
 
 	case EXEC_ENTRY:
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index c4cdcd68193..dd3ea1a81ab 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -3806,19 +3806,20 @@ gfc_build_builtin_function_decls (void)
 
       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);
+	    get_identifier (PREFIX("caf_form_team")), "RWRWWW",
+	    void_type_node, 6, integer_type_node, ppvoid_type_node,
+	    integer_type_node, pint_type, pchar_type_node, size_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);
+	    get_identifier (PREFIX("caf_change_team")), "RWWW",
+	    void_type_node, 4, ppvoid_type_node, pint_type, pchar_type_node,
+	    size_type_node);
 
       gfor_fndecl_caf_end_team
-	= gfc_build_library_function_decl (
-	    get_identifier (PREFIX("caf_end_team")), void_type_node, 0);
+	= gfc_build_library_function_decl_with_spec (
+	    get_identifier (PREFIX("caf_end_team")), "WWW", void_type_node, 3,
+	    pint_type, pchar_type_node, size_type_node);
 
       gfor_fndecl_caf_get_team
 	= gfc_build_library_function_decl_with_spec (
@@ -3827,9 +3828,9 @@ gfc_build_builtin_function_decls (void)
 
       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);
+	    get_identifier (PREFIX("caf_sync_team")), "RWWW",
+	    void_type_node, 4, ppvoid_type_node, pint_type, pchar_type_node,
+	    size_type_node);
 
       gfor_fndecl_caf_team_number
       	= gfc_build_library_function_decl_with_spec (
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 6b785a6db4e..5b0e48f4559 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -708,8 +708,9 @@ gfc_trans_form_team (gfc_code *code)
   if (flag_coarray == GFC_FCOARRAY_LIB)
     {
       gfc_se se;
-      gfc_se argse1, argse2;
-      tree team_id, team_type, tmp;
+      gfc_se argse1, argse2, argse, new_indexse;
+      tree team_id, team_type, new_index, stat, errmsg, errmsg_len, tmp;
+      tree stat2 = NULL_TREE;
 
       gfc_init_se (&se, NULL);
       gfc_init_se (&argse1, NULL);
@@ -723,13 +724,64 @@ gfc_trans_form_team (gfc_code *code)
 
       gfc_add_block_to_block (&se.pre, &argse1.pre);
       gfc_add_block_to_block (&se.pre, &argse2.pre);
+
+      /* NEW_INDEX=.  */
+      if (code->expr3)
+	{
+	  gfc_init_se (&new_indexse, NULL);
+	  gfc_conv_expr_val (&new_indexse, code->expr3);
+	  new_index = new_indexse.expr;
+	}
+      else
+	new_index = null_pointer_node;
+
+      /* STAT=.  */
+      if (code->expr4)
+	{
+	  gcc_assert (code->expr4->expr_type == EXPR_VARIABLE);
+	  gfc_init_se (&argse, NULL);
+	  gfc_conv_expr_val (&argse, code->expr4);
+	  stat = argse.expr;
+	}
+      else
+	stat = null_pointer_node;
+
+      /* ERRMSG= only makes sense with STAT=.  */
+      if (code->expr4 && code->expr5)
+	{
+	  gfc_init_se (&argse, NULL);
+	  argse.want_pointer = 1;
+	  gfc_conv_expr (&argse, code->expr5);
+	  gfc_add_block_to_block (&se.pre, &argse.pre);
+	  errmsg = argse.expr;
+	  errmsg_len = fold_convert (size_type_node, argse.string_length);
+	}
+      else
+	{
+	  errmsg = null_pointer_node;
+	  errmsg_len = build_zero_cst (size_type_node);
+	}
+
+      if (stat != null_pointer_node && TREE_TYPE (stat) != integer_type_node)
+	{
+	  stat2 = stat;
+	  stat = gfc_create_var (integer_type_node, "stat");
+	}
+
       tmp = build_call_expr_loc (input_location,
-				 gfor_fndecl_caf_form_team, 3,
-				 team_id, team_type,
-				 build_int_cst (integer_type_node, 0));
+				 gfor_fndecl_caf_form_team, 6,
+				 team_id, team_type, new_index,
+				 stat != null_pointer_node
+				 ? gfc_build_addr_expr (NULL, stat) : stat,
+				 errmsg, errmsg_len);
       gfc_add_expr_to_block (&se.pre, tmp);
       gfc_add_block_to_block (&se.pre, &argse1.post);
       gfc_add_block_to_block (&se.pre, &argse2.post);
+      if (new_index != null_pointer_node)
+	gfc_add_block_to_block (&se.pre, &new_indexse.post);
+      if (stat2 != NULL_TREE)
+	gfc_add_modify (&se.pre, stat2,
+			fold_convert (TREE_TYPE (stat2), stat));
       return gfc_finish_block (&se.pre);
     }
   else
@@ -748,19 +800,63 @@ gfc_trans_change_team (gfc_code *code)
 {
   if (flag_coarray == GFC_FCOARRAY_LIB)
     {
-      gfc_se argse;
-      tree team_type, tmp;
+      gfc_se argse, se, team_typese;
+      tree team_type, stat, errmsg, errmsg_len, tmp, stat2 = NULL_TREE;
 
+      gfc_init_se (&se, NULL);
       gfc_init_se (&argse, NULL);
-      gfc_conv_expr_val (&argse, code->expr1);
-      team_type = gfc_build_addr_expr (ppvoid_type_node, argse.expr);
+      gfc_init_se (&team_typese, NULL);
+      gfc_start_block (&se.pre);
+
+      gfc_conv_expr_val (&team_typese, code->expr1);
+      team_type = gfc_build_addr_expr (ppvoid_type_node, team_typese.expr);
+
+      gfc_add_block_to_block (&se.pre, &team_typese.pre);
+
+      /* STAT=.  */
+      if (code->expr2)
+	{
+	  gcc_assert (code->expr2->expr_type == EXPR_VARIABLE);
+	  gfc_init_se (&argse, NULL);
+	  gfc_conv_expr_val (&argse, code->expr2);
+	  stat = argse.expr;
+	}
+      else
+	stat = null_pointer_node;
+
+      /* ERRMSG= only makes sense with STAT=.  */
+      if (code->expr2 && code->expr3)
+	{
+	  gfc_init_se (&argse, NULL);
+	  argse.want_pointer = 1;
+	  gfc_conv_expr (&argse, code->expr3);
+	  gfc_add_block_to_block (&se.pre, &argse.pre);
+	  errmsg = argse.expr;
+	  errmsg_len = fold_convert (size_type_node, argse.string_length);
+	}
+      else
+	{
+	  errmsg = null_pointer_node;
+	  errmsg_len = build_zero_cst (size_type_node);
+	}
+
+      if (stat != null_pointer_node && TREE_TYPE (stat) != integer_type_node)
+	{
+	  stat2 = stat;
+	  stat = gfc_create_var (integer_type_node, "stat");
+	}
 
       tmp = build_call_expr_loc (input_location,
-				 gfor_fndecl_caf_change_team, 2, team_type,
-				 build_int_cst (integer_type_node, 0));
-      gfc_add_expr_to_block (&argse.pre, tmp);
-      gfc_add_block_to_block (&argse.pre, &argse.post);
-      return gfc_finish_block (&argse.pre);
+				 gfor_fndecl_caf_change_team, 4, team_type,
+				 stat != null_pointer_node
+				 ? gfc_build_addr_expr (NULL, stat) : stat,
+				 errmsg, errmsg_len);
+      gfc_add_expr_to_block (&se.pre, tmp);
+      gfc_add_block_to_block (&se.pre, &team_typese.post);
+      if (stat2 != NULL_TREE)
+	gfc_add_modify (&se.pre, stat2,
+			fold_convert (TREE_TYPE (stat2), stat));
+      return gfc_finish_block (&se.pre);
     }
   else
     {
@@ -774,13 +870,58 @@ gfc_trans_change_team (gfc_code *code)
 /* Translate the END TEAM statement.  */
 
 tree
-gfc_trans_end_team (gfc_code *code ATTRIBUTE_UNUSED)
+gfc_trans_end_team (gfc_code *code)
 {
   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));
+      gfc_se argse, se;
+      tree stat, errmsg, errmsg_len, tmp, stat2 = NULL_TREE;
+
+      gfc_init_se (&se, NULL);
+      gfc_init_se (&argse, NULL);
+      gfc_start_block (&se.pre);
+
+      if (code->expr1)
+	{
+	  gcc_assert (code->expr1->expr_type == EXPR_VARIABLE);
+	  gfc_init_se (&argse, NULL);
+	  gfc_conv_expr_val (&argse, code->expr1);
+	  stat = argse.expr;
+	}
+      else
+	stat = null_pointer_node;
+
+      if (code->expr2)
+	{
+	  gfc_init_se (&argse, NULL);
+	  argse.want_pointer = 1;
+	  gfc_conv_expr (&argse, code->expr2);
+	  gfc_add_block_to_block (&se.pre, &argse.pre);
+	  errmsg = argse.expr;
+	  errmsg_len = fold_convert (size_type_node, argse.string_length);
+	}
+      else
+	{
+	  errmsg = null_pointer_node;
+	  errmsg_len = build_zero_cst (size_type_node);
+	}
+
+      if (stat != null_pointer_node && TREE_TYPE (stat) != integer_type_node)
+	{
+	  stat2 = stat;
+	  stat = gfc_create_var (integer_type_node, "stat");
+	}
+
+      tmp = build_call_expr_loc (input_location,
+				 gfor_fndecl_caf_end_team, 3,
+				 stat != null_pointer_node
+				 ? gfc_build_addr_expr (NULL, stat) : stat,
+				 errmsg, errmsg_len);
+      gfc_add_expr_to_block (&se.pre, tmp);
+      if (stat2 != NULL_TREE)
+	gfc_add_modify (&se.pre, stat2,
+			fold_convert (TREE_TYPE (stat2), stat));
+      return gfc_finish_block (&se.pre);
     }
   else
     {
@@ -798,20 +939,63 @@ gfc_trans_sync_team (gfc_code *code)
 {
   if (flag_coarray == GFC_FCOARRAY_LIB)
     {
-      gfc_se argse;
-      tree team_type, tmp;
+      gfc_se argse, se, team_typese;
+      tree team_type, stat, errmsg, errmsg_len, tmp, stat2 = NULL_TREE;
 
+      gfc_init_se (&se, NULL);
       gfc_init_se (&argse, NULL);
-      gfc_conv_expr_val (&argse, code->expr1);
-      team_type = gfc_build_addr_expr (ppvoid_type_node, argse.expr);
+      gfc_init_se (&team_typese, NULL);
+      gfc_start_block (&se.pre);
+
+      gfc_conv_expr_val (&team_typese, code->expr1);
+      team_type = gfc_build_addr_expr (ppvoid_type_node, team_typese.expr);
+
+      gfc_add_block_to_block (&se.pre, &team_typese.pre);
+
+      /* STAT=.  */
+      if (code->expr2)
+	{
+	  gcc_assert (code->expr2->expr_type == EXPR_VARIABLE);
+	  gfc_init_se (&argse, NULL);
+	  gfc_conv_expr_val (&argse, code->expr2);
+	  stat = argse.expr;
+	}
+      else
+	stat = null_pointer_node;
+
+      /* ERRMSG= only makes sense with STAT=.  */
+      if (code->expr2 && code->expr3)
+	{
+	  gfc_init_se (&argse, NULL);
+	  argse.want_pointer = 1;
+	  gfc_conv_expr (&argse, code->expr3);
+	  gfc_add_block_to_block (&se.pre, &argse.pre);
+	  errmsg = argse.expr;
+	  errmsg_len = fold_convert (size_type_node, argse.string_length);
+	}
+      else
+	{
+	  errmsg = null_pointer_node;
+	  errmsg_len = build_zero_cst (size_type_node);
+	}
+
+      if (stat != null_pointer_node && TREE_TYPE (stat) != integer_type_node)
+	{
+	  stat2 = stat;
+	  stat = gfc_create_var (integer_type_node, "stat");
+	}
 
       tmp = build_call_expr_loc (input_location,
-				 gfor_fndecl_caf_sync_team, 2,
-				 team_type,
-				 build_int_cst (integer_type_node, 0));
-      gfc_add_expr_to_block (&argse.pre, tmp);
-      gfc_add_block_to_block (&argse.pre, &argse.post);
-      return gfc_finish_block (&argse.pre);
+				 gfor_fndecl_caf_sync_team, 4, team_type,
+				 stat != null_pointer_node
+				 ? gfc_build_addr_expr (NULL, stat) : stat,
+				 errmsg, errmsg_len);
+      gfc_add_expr_to_block (&se.pre, tmp);
+      gfc_add_block_to_block (&se.pre, &team_typese.post);
+      if (stat2 != NULL_TREE)
+	gfc_add_modify (&se.pre, stat2,
+			fold_convert (TREE_TYPE (stat2), stat));
+      return gfc_finish_block (&se.pre);
     }
   else
     {
@@ -1571,19 +1755,93 @@ gfc_trans_critical (gfc_code *code)
 {
   stmtblock_t block;
   tree tmp, token = NULL_TREE;
+  tree cond, stat = NULL_TREE, errmsg, errmsg_len, stat2 = NULL_TREE;
+  gfc_se argse;
 
   gfc_start_block (&block);
 
   if (flag_coarray == GFC_FCOARRAY_LIB)
     {
+      /* STAT=.  */
+      if (code->expr1)
+	{
+	  gcc_assert (code->expr1->expr_type == EXPR_VARIABLE);
+	  gfc_init_se (&argse, NULL);
+	  gfc_conv_expr_val (&argse, code->expr1);
+	  stat = argse.expr;
+	}
+      else
+	stat = null_pointer_node;
+
+      /* ERRMSG= only makes sense with STAT=.  */
+      if (code->expr1 && code->expr2)
+	{
+	  gfc_init_se (&argse, NULL);
+	  argse.want_pointer = 1;
+	  gfc_conv_expr (&argse, code->expr2);
+	  gfc_add_block_to_block (&block, &argse.pre);
+	  errmsg = argse.expr;
+	  errmsg_len = fold_convert (size_type_node, argse.string_length);
+	}
+      else
+	{
+	  errmsg = null_pointer_node;
+	  errmsg_len = build_zero_cst (size_type_node);
+	}
+
+      if (stat != null_pointer_node && TREE_TYPE (stat) != integer_type_node)
+	{
+	  stat2 = stat;
+	  stat = gfc_create_var (integer_type_node, "stat");
+	}
+
       token = gfc_get_symbol_decl (code->resolved_sym);
       token = GFC_TYPE_ARRAY_CAF_TOKEN (TREE_TYPE (token));
       tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_lock, 7,
 				 token, integer_zero_node, integer_one_node,
-				 null_pointer_node, null_pointer_node,
-				 null_pointer_node, integer_zero_node);
+				 null_pointer_node,
+				 stat != null_pointer_node
+				 ? gfc_build_addr_expr (NULL, stat) : stat,
+				 errmsg, errmsg_len);
       gfc_add_expr_to_block (&block, tmp);
 
+      if (stat != null_pointer_node)
+      {
+	/* If stat is set to one of STAT_UNLOCKED_FAILED_IMAGE or
+	 * STAT_FAILED_IMAGE, set its value to the other.
+	 */
+	 /* (stat == STAT_FAILED_IMAGE) */
+	cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
+				stat, build_int_cst (integer_type_node,
+						     GFC_STAT_FAILED_IMAGE));
+	/* (((stat == STAT_FAILED_IMAGE) ? STAT_UNLOCKED_FAILED_IMAGE : stat) */
+	tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node,
+			       cond, build_int_cst (integer_type_node,
+					      GFC_STAT_UNLOCKED_FAILED_IMAGE),
+			       stat);
+	/* (stat == STAT_UNLOCKED_FAILED_IMAGE) */
+	cond = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
+				stat, build_int_cst (integer_type_node,
+					     GFC_STAT_UNLOCKED_FAILED_IMAGE));
+	/* (stat == STAT_UNLOCKED_FAILED_IMAGE) ? STAT_FAILED_IMAGE :
+	 *  ((stat == STAT_FAILED_IMAGE) ? STAT_UNLOCKED_FAILED_IMAGE : stat)
+	 */
+	tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node,
+			       cond, build_int_cst (integer_type_node,
+						    GFC_STAT_FAILED_IMAGE),
+			       tmp);
+
+	/* assign result to stat.  */
+	gfc_add_modify (&block, stat,
+			fold_convert (TREE_TYPE (stat), tmp));
+
+	gfc_add_expr_to_block (&block, tmp);
+
+	if (stat2 != NULL_TREE)
+	  gfc_add_modify (&block, stat2,
+			  fold_convert (TREE_TYPE (stat2), stat));
+      }
+
       /* It guarantees memory consistency within the same segment */
       tmp = gfc_build_string_const (strlen ("memory")+1, "memory"),
 	tmp = build5_loc (input_location, ASM_EXPR, void_type_node,
@@ -1601,10 +1859,18 @@ gfc_trans_critical (gfc_code *code)
 
   if (flag_coarray == GFC_FCOARRAY_LIB)
     {
+      /* END CRITICAL does not accept STAT or ERRMSG arguments.
+       * If STAT= is specified for CRITICAL, pass a stat argument to
+       * _gfortran_caf_lock_unlock to prevent termination in the event of an
+       * error, but ignore any value assigned to it.
+       */
       tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_unlock, 6,
 				 token, integer_zero_node, integer_one_node,
-				 null_pointer_node, null_pointer_node,
-				 integer_zero_node);
+				 stat != NULL_TREE
+				 ? gfc_build_addr_expr (NULL,
+				    gfc_create_var (integer_type_node, "stat"))
+				 : null_pointer_node,
+				 null_pointer_node, integer_zero_node);
       gfc_add_expr_to_block (&block, tmp);
 
       /* It guarantees memory consistency within the same segment */
diff --git a/gcc/testsuite/gfortran.dg/coarray_critical_2.f90 b/gcc/testsuite/gfortran.dg/coarray_critical_2.f90
new file mode 100644
index 00000000000..1a698eadab8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_critical_2.f90
@@ -0,0 +1,27 @@
+! PR 87939
+! { dg-do compile }
+! { dg-options "-fcoarray=lib" }
+!
+! Test critical syntax errors with stat= and errmsg= specifiers
+!
+  implicit none
+  integer :: istat
+  character(len=30) :: err
+
+  critical (stat=err) ! { dg-error "must be a scalar INTEGER" }
+    continue
+  end critical
+
+  critical (stat=istat, stat=istat) ! { dg-error "Redundant STAT" }
+    continue
+  end critical
+
+  critical (stat=istat, errmsg=istat) ! { dg-error "must be a scalar CHARACTER variable" }
+    continue
+  end critical
+
+  critical (stat=istat, errmsg=err, errmsg=err) ! { dg-error "Redundant ERRMSG" }
+    continue
+  end critical
+
+end
diff --git a/gcc/testsuite/gfortran.dg/coarray_critical_3.f90 b/gcc/testsuite/gfortran.dg/coarray_critical_3.f90
new file mode 100644
index 00000000000..233712cc12e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_critical_3.f90
@@ -0,0 +1,20 @@
+! PR 87939
+! { dg-do compile }
+! { dg-options "-fcoarray=lib -fdump-tree-original" }
+!
+! Test critical construct with stat= and errmsg= specifiers
+!
+  use, intrinsic :: iso_fortran_env, only: int16
+  implicit none
+  integer :: istat
+  integer(kind=int16) :: istat16
+  character(len=30) :: err
+
+  critical (stat=istat, errmsg=err)
+    continue
+  end critical
+end
+
+! { dg-final { scan-tree-dump "_gfortran_caf_lock \\(caf_token.\[0-9\]+, 0, 1, 0B, &istat, &err, 30\\);" "original" } }
+! { dg-final { scan-tree-dump "istat = istat != 6002 \\? istat != 6001 \\? istat : 6002 : 6001;" "original" } }
+! { dg-final { scan-tree-dump "_gfortran_caf_unlock \\(caf_token.\[0-9\]+, 0, 1, &stat.\[0-9\]+, 0B, 0\\);" "original" } }
diff --git a/gcc/testsuite/gfortran.dg/coarray_critical_4.f90 b/gcc/testsuite/gfortran.dg/coarray_critical_4.f90
new file mode 100644
index 00000000000..2d73b90bde1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_critical_4.f90
@@ -0,0 +1,20 @@
+! PR 87939
+! { dg-do compile }
+! { dg-options "-fcoarray=lib -fdump-tree-original" }
+!
+! Test critical construct with (int16) stat= and errmsg= specifiers
+!
+  use, intrinsic :: iso_fortran_env, only: int16
+  implicit none
+  integer(kind=int16) :: istat
+  character(len=30) :: err
+
+  critical (stat=istat, errmsg=err)
+    continue
+  end critical
+end
+
+! { dg-final { scan-tree-dump "_gfortran_caf_lock \\(caf_token.\[0-9\]+, 0, 1, 0B, &stat.\[0-9\]+, &err, 30\\);" "original" } }
+! { dg-final { scan-tree-dump "stat.\[0-9\]+ = stat.\[0-9\]+ != 6002 \\? stat.\[0-9\]+ != 6001 \\? stat.\[0-9\]+ : 6002 : 6001;" "original" } }
+! { dg-final { scan-tree-dump "istat = \\(integer\\(kind=\[0-9\]+\\)\\) stat.\[0-9\]+" "original" } }
+! { dg-final { scan-tree-dump "_gfortran_caf_unlock \\(caf_token.\[0-9\]+, 0, 1, &stat.\[0-9\]+, 0B, 0\\);" "original" } }
diff --git a/gcc/testsuite/gfortran.dg/team_change_2.f90 b/gcc/testsuite/gfortran.dg/team_change_2.f90
new file mode 100644
index 00000000000..6e8971ce31f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/team_change_2.f90
@@ -0,0 +1,41 @@
+! PR 87939
+! { dg-do compile }
+! { dg-options "-fcoarray=lib" }
+!
+! Tests change team syntax
+!
+  use iso_fortran_env, only : team_type
+  implicit none
+  type(team_type) :: team
+  integer :: new_team, istat
+  character(len=30) :: err
+
+  new_team = mod(this_image(),2)+1
+
+  form team (new_team,team)
+
+  change team ! { dg-error "Syntax error in CHANGE TEAM statement" }
+    continue
+  end team
+
+  change team (err) ! { dg-error "must be a scalar TEAM_TYPE expression" }
+    continue
+  end team
+
+  change team (team, stat=err) ! { dg-error "must be a scalar INTEGER" }
+    continue
+  end team
+
+  change team (team, stat=istat, stat=istat) ! { dg-error "Redundant STAT" }
+    continue
+  end team
+
+  change team (team, stat=istat, errmsg=istat) ! { dg-error "must be a scalar CHARACTER variable" }
+    continue
+  end team
+
+  change team (team, stat=istat, errmsg=str, errmsg=str) ! { dg-error "Redundant ERRMSG" }
+    continue
+  end team
+end
+
diff --git a/gcc/testsuite/gfortran.dg/team_change_3.f90 b/gcc/testsuite/gfortran.dg/team_change_3.f90
new file mode 100644
index 00000000000..f835ccdb350
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/team_change_3.f90
@@ -0,0 +1,28 @@
+! PR 87939
+! { dg-do compile }
+! { dg-options "-fcoarray=lib -fdump-tree-original" }
+!
+! Tests change team stat= and errmsg= specifiers
+!
+  use iso_fortran_env, only : team_type
+  implicit none
+  type(team_type) :: team
+  integer :: new_team, istat
+  character(len=30) :: err
+
+  new_team = mod(this_image(),2)+1
+
+  form team (new_team,team)
+
+  change team (team, stat=istat)
+    continue
+  end team
+
+  change team (team, stat=istat, errmsg=err)
+    continue
+  end team
+
+end
+
+! { dg-final { scan-tree-dump "_gfortran_caf_change_team \\(&team, &istat, 0B, 0\\)" "original" } }
+! { dg-final { scan-tree-dump "_gfortran_caf_change_team \\(&team, &istat, &err, 30\\)" "original" } }
diff --git a/gcc/testsuite/gfortran.dg/team_end_2.f90 b/gcc/testsuite/gfortran.dg/team_end_2.f90
new file mode 100644
index 00000000000..4953edb056f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/team_end_2.f90
@@ -0,0 +1,33 @@
+! PR 87939
+! { dg-do compile }
+! { dg-options "-fcoarray=lib" }
+!
+! Tests change team syntax
+!
+  use iso_fortran_env, only : team_type
+  implicit none
+  type(team_type) :: team
+  integer :: new_team, istat
+  character(len=30) :: err
+
+  new_team = mod(this_image(),2)+1
+
+  form team (new_team,team)
+
+  change team (team)
+    continue
+  end team (stat=err) ! { dg-error "must be a scalar INTEGER" }
+
+  change team (team)
+    continue
+  end team (stat=istat, stat=istat) ! { dg-error "Redundant STAT" }
+
+  change team (team)
+    continue
+  end team (stat=istat, errmsg=istat) ! { dg-error "must be a scalar CHARACTER variable" }
+
+  change team (team)
+    continue
+  end team (stat=istat, errmsg=str, errmsg=str) ! { dg-error "Redundant ERRMSG" }
+end
+
diff --git a/gcc/testsuite/gfortran.dg/team_end_3.f90 b/gcc/testsuite/gfortran.dg/team_end_3.f90
new file mode 100644
index 00000000000..6638f933510
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/team_end_3.f90
@@ -0,0 +1,28 @@
+! PR 87939
+! { dg-do compile }
+! { dg-options "-fcoarray=lib -fdump-tree-original" }
+!
+! Tests end team stat= and errmsg= specifiers
+!
+  use iso_fortran_env, only : team_type
+  implicit none
+  type(team_type) :: team
+  integer :: new_team, istat
+  character(len=30) :: err
+
+  new_team = mod(this_image(),2)+1
+
+  form team (new_team,team)
+
+  change team (team)
+    continue
+  end team (stat=istat)
+
+  change team (team)
+    continue
+  end team (stat=istat, errmsg=err)
+
+end
+
+! { dg-final { scan-tree-dump "_gfortran_caf_end_team \\(&istat, 0B, 0\\)" "original" } }
+! { dg-final { scan-tree-dump "_gfortran_caf_end_team \\(&istat, &err, 30\\)" "original" } }
diff --git a/gcc/testsuite/gfortran.dg/team_form_2.f90 b/gcc/testsuite/gfortran.dg/team_form_2.f90
new file mode 100644
index 00000000000..c47c372f143
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/team_form_2.f90
@@ -0,0 +1,26 @@
+! PR 87939
+! { dg-do compile }
+! { dg-options "-fcoarray=lib" }
+!
+! Tests form team syntax errors
+!
+  use iso_fortran_env, only : team_type
+  implicit none
+  integer :: istat, new_team
+  character(len=30) :: err
+  type(team_type) :: team
+
+   new_team = mod(this_image(),2)+1
+
+  form team ! { dg-error "Syntax error in FORM TEAM statement" }
+  form team (new_team) ! { dg-error "Syntax error in FORM TEAM statement" }
+  form team (new_team,err) ! { dg-error "must be a scalar of type TEAM_TYPE" }
+  form team (new_team,team,istat) ! { dg-error "Syntax error in FORM TEAM statement" }
+  form team (new_team,team,stat=istat,stat=istat) ! { dg-error "Redundant STAT" }
+  form team (new_team,team,stat=istat,errmsg=istat) ! { dg-error "must be a scalar CHARACTER variable" }
+  form team (new_team,team,stat=istat,errmsg=err,errmsg=err) ! { dg-error "Redundant ERRMSG" }
+  form team (new_team,team,new_index=1,new_index=1) ! { dg-error "Redundant NEW_INDEX" }
+  form team (new_team,team,new_index=err) ! { dg-error "must be a scalar INTEGER" }
+  form team (new_team,team,new_index=1,new_index=1,stat=istat,errmsg=err) ! { dg-error "Redundant NEW_INDEX" }
+
+end
diff --git a/gcc/testsuite/gfortran.dg/team_form_3.f90 b/gcc/testsuite/gfortran.dg/team_form_3.f90
new file mode 100644
index 00000000000..d6957931905
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/team_form_3.f90
@@ -0,0 +1,28 @@
+! PR 87939
+! { dg-do compile }
+! { dg-options "-fcoarray=lib -fdump-tree-original" }
+!
+! Tests form team with stat= and errmsg=
+!
+  use iso_fortran_env, only : team_type
+  implicit none
+  integer :: istat, new_team
+  character(len=30) :: err = "unchanged"
+  type(team_type) :: team
+
+  new_team = mod(this_image(),2)+1
+
+  form team (new_team,team)
+  form team (new_team,team,stat=istat)
+  form team (new_team,team,stat=istat, errmsg=err)
+  form team (new_team,team,new_index=1)
+  form team (new_team,team,new_index=1,stat=istat)
+  form team (new_team,team,new_index=1,stat=istat,errmsg=err)
+end
+
+! { dg-final { scan-tree-dump "_gfortran_caf_form_team \\(new_team, &team, 0B, 0B, 0B, 0\\)" "original" } }
+! { dg-final { scan-tree-dump "_gfortran_caf_form_team \\(new_team, &team, 0B, &istat, 0B, 0\\)" "original" } }
+! { dg-final { scan-tree-dump "_gfortran_caf_form_team \\(new_team, &team, 0B, &istat, &err, 30\\)" "original" } }
+! { dg-final { scan-tree-dump "_gfortran_caf_form_team \\(new_team, &team, 1, 0B, 0B, 0\\)" "original" } }
+! { dg-final { scan-tree-dump "_gfortran_caf_form_team \\(new_team, &team, 1, &istat, 0B, 0\\)" "original" } }
+! { dg-final { scan-tree-dump "_gfortran_caf_form_team \\(new_team, &team, 1, &istat, &err, 30\\)" "original" } }
diff --git a/gcc/testsuite/gfortran.dg/team_sync_1.f90 b/gcc/testsuite/gfortran.dg/team_sync_1.f90
new file mode 100644
index 00000000000..5e496816cc9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/team_sync_1.f90
@@ -0,0 +1,24 @@
+! PR 87939
+! { dg-do compile }
+! { dg-options "-fcoarray=lib" }
+!
+! Test sync team syntax errors
+!
+  use iso_fortran_env, only : team_type
+  implicit none
+  integer :: istat
+  character(len=30) :: err
+  type(team_type) :: team
+
+  form team (mod(this_image(),2)+1, team)
+
+  change team (team)
+    sync team ! { dg-error "Syntax error in SYNC TEAM statement" }
+    sync team (err) ! { dg-error "must be a scalar TEAM_TYPE expression" }
+    sync team (team, istat) ! { dg-error "Syntax error in SYNC TEAM statement" }
+    sync team (team, stat=err) ! { dg-error "must be a scalar INTEGER" }
+    sync team (team, stat=istat, stat=istat) ! { dg-error "Redundant STAT" }
+    sync team (team, stat=istat, errmsg=istat) ! { dg-error "must be a scalar CHARACTER variable" }
+    sync team (team, stat=istat, errmsg=err, errmsg=err) ! { dg-error "Redundant ERRMSG" }
+  end team
+end
diff --git a/gcc/testsuite/gfortran.dg/team_sync_2.f90 b/gcc/testsuite/gfortran.dg/team_sync_2.f90
new file mode 100644
index 00000000000..9884e4e6857
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/team_sync_2.f90
@@ -0,0 +1,24 @@
+! PR 87939
+! { dg-do compile }
+! { dg-options "-fcoarray=lib -fdump-tree-original" }
+!
+! Test sync team statement
+!
+  use iso_fortran_env, only : team_type
+  implicit none
+  integer :: istat
+  type(team_type) :: team
+  character(len=30) :: err = "unchanged"
+
+  form team (mod(this_image(),2)+1, team)
+
+  change team (team)
+    sync team (team)
+    sync team (team, stat=istat)
+    sync team (team, stat=istat, errmsg=err)
+  end team
+end
+
+! { dg-final { scan-tree-dump "_gfortran_caf_sync_team \\(&team, 0B, 0B, 0\\)" "original" } }
+! { dg-final { scan-tree-dump "_gfortran_caf_sync_team \\(&team, &istat, 0B, 0\\)" "original" } }
+! { dg-final { scan-tree-dump "_gfortran_caf_sync_team \\(&team, &istat, &err, 30\\)" "original" } }
diff --git a/libgfortran/caf/libcaf.h b/libgfortran/caf/libcaf.h
index d1cfa8dd914..09deb28773d 100644
--- a/libgfortran/caf/libcaf.h
+++ b/libgfortran/caf/libcaf.h
@@ -50,7 +50,8 @@ typedef enum
   CAF_STAT_LOCKED,
   CAF_STAT_LOCKED_OTHER_IMAGE,
   CAF_STAT_STOPPED_IMAGE = 6000,
-  CAF_STAT_FAILED_IMAGE  = 6001
+  CAF_STAT_FAILED_IMAGE  = 6001,
+  CAF_STAT_UNLOCKED_FAILED_IMAGE = 6002
 }
 caf_stat_codes_t;
 

Re: [PATCH,Fortran][RFC] PR 87939, 87326 - STAT= and ERRMSG= specifiers in several image control statements; NEW_INDEX= specifier in FORM TEAM statement

[Steve Kargl]

Nathan,

Thanks for taking an interesting in improving gfortran.  A
scan of the bug database certainly suggests we can use the
help particularly with coarray bugs.  Before we can go much
further, do you have a copyright assignment on file the FSF.
If not, please see https://gcc.gnu.org/contribute.html

-- 
steve

On Wed, Jan 16, 2019 at 06:16:12PM -0600, Nathan Weeks wrote:
> Hi all,
> 
> To facilitate more complete Fortran 2018 failed images support, I'm
> particularly interested in interested in seeing PR 87939 eventually
> resolved (i.e., allow STAT= and ERRMSG= specifiers in FORM TEAM,
> CHANGE TEAM, SYNC TEAM, END TEAM, and CRITICAL statements). To get the
> ball rolling (I realize that the boat has been missed for this kind of
> change in GCC 9 trunk), I've attempted the following patch (which,
> since it was convenient to do while modifying FORM TEAM-related code,
> also adds the NEW_INDEX= specifier to the FORM TEAM statement as
> desired in PR 87326).
> 
> This is the first gfortran patch I've attempted, and I certainly could
> have made some noob mistakes, so verbose feedback would be
> appreciated.
> 
> A few comments:
> 
> * In resolve.c, the newly-added functions that type check STAT= and
> ERRMSG= arguments for FORM TEAM, CHANGE TEAM, and SYNC TEAM also add
> (previously-absent) type checking for their TEAM_TYPE arguments. If
> it's more appropriate, I could separate this change into its own PR.
> 
> * The existing -fcoarray=lib implementation of CRITICAL acquires a
> LOCK on a lock variable on image 1 (in the current team). However, a
> CRITICAL statement stat-value of STAT_FAILED_IMAGE (i.e., the image
> that enter the CRITICAL construct failed) is analogous to the LOCK
> stat-value of STAT_UNLOCKED_FAILED_IMAGE (i.e., the image that
> acquired the lock failed---see section 11.6.11 (7 & 10) in Fortran
> 2018 draft N2146), whereas a LOCK STAT_FAILED_IMAGE means the image on
> which the lock variable resides has failed (no analog in the CRITICAL
> statement, which is oblivious to this underlying implementation). So
> in addition to adding the stat value STAT_UNLOCKED_FAILED_IMAGE to
> libgfortran.h & libcaf.h, I had CRITICAL swap a LOCK
> STAT_UNLOCKED_FAILED_IMAGE for STAT_FAILED_IMAGE, and (perhaps
> unimaginatively) a LOCK STAT_FAILED_IMAGE for
> STAT_UNLOCKED_FAILED_IMAGE (which, while it has no defined meaning for
> a CRITICAL statement, fits the definition of a "processor-dependent
> value other than STAT_FAILED_IMAGE").
> 
> * A couple negative tests for syntax errors (coarray_critical_2.f90 &
> team_end_2.f90) fail due to spurious "Error: Expecting END PROGRAM
> statement at (1)" errors that are also emitted by gfortran 8.2.0 as
> well.
> 
> Thanks,
> 
> --
> Nathan
> 
> frontend:
> 
> 2019-01-16  Nathan Weeks  <weeks@iastate.edu>
> 
>         PR fortran/87939
>         PR fortran/87326
>         * gfortran.h: Add an additional gfc_expr member to struct gfc_code.
>         * libcaf.h: Add support for STAT_UNLOCKED_FAILED_IMAGE.
>         * match.c (gfc_match_critical): Add STAT= and ERRMSG=.
>         (gfc_match_change_team): Likewise.
>         (gfc_match_end_team): Likewise.
>         (gfc_match_sync_team): Likewise.
>         (gfc_match_form_team): Add STAT=, ERRMSG=, and NEW_INDEX=.
>         * resolve.c (resolve_form_team): New. Type check team-variable
> argument in
>         addition to new STAT= and ERRMSG= arguments.
>         (resolve_change_sync_team): New. Adds type checking for team-value
>         argument.
>         (resolve_end_team): New.
>         (resolve_critical): Add STAT= and ERRMSG=.
>         * trans-decl.c (gfc_build_builtin_function_decls): Additional stat,
>         errmsg, and errmsg_len arguments to _gfortran_caf_form_team(),
>         _gfortran_caf_change_team(), _gfortran_caf_end_team(), and
>         _gfortran_caf_sync_team(), and additional new_index argument to
>         _gfortran_caf_form_team().
>         * trans-stmt.c (gfc_trans_form_team): Support STAT=, ERRMSG=, and
>         NEW_INDEX=.
>         (gfc_trans_change_team): Support STAT= and ERRMSG=.
>         (gfc_trans_end_team): Likewise.
>         (gfc_trans_sync_team): Likewise.
>         (gfc_trans_critical): Likewise. Also support assigning STAT_FAILED_IMAGE
>         to a stat-variable.
> 
> libgfortran:
> 
> 2019-01-16  Nathan Weeks  <weeks@iastate.edu>
> 
>         PR fortran/87939
>         * libgfortran.h: Add support for STAT_UNLOCKED_FAILED_IMAGE
> 
> testsuite:
> 
> 2019-01-16  Nathan Weeks  <weeks@iastate.edu>
> 
>         PR fortran/87939
>         PR fortran/87326
>         * gfortran.dg/coarray_critical_2.f90: New test
>         * gfortran.dg/coarray_critical_3.f90: New test
>         * gfortran.dg/coarray_critical_4.f90: New test
>         * gfortran.dg/team_change_2.f90: New test
>         * gfortran.dg/team_change_3.f90: New test
>         * gfortran.dg/team_end_2.f90: New test
>         * gfortran.dg/team_end_3.f90: New test
>         * gfortran.dg/team_form_2.f90: New test
>         * gfortran.dg/team_form_3.f90: New test
>         * gfortran.dg/team_sync_1.f90: New test
>         * gfortran.dg/team_sync_2.f90: New test



-- 
Steve
20170425 https://www.youtube.com/watch?v=VWUpyCsUKR4
20161221 https://www.youtube.com/watch?v=IbCHE-hONow

Re: [PATCH,Fortran][RFC] PR 87939, 87326 - STAT= and ERRMSG= specifiers in several image control statements; NEW_INDEX= specifier in FORM TEAM statement

[Nathan Weeks]

Hi Steve,

I currently do not, but I will contact appropriate personnel & try to get
one submitted soon.

--
Nathan


On Wed, Jan 16, 2019 at 8:24 PM Steve Kargl <
sgk@troutmask.apl.washington.edu> wrote:

> Nathan,
>
> Thanks for taking an interesting in improving gfortran.  A
> scan of the bug database certainly suggests we can use the
> help particularly with coarray bugs.  Before we can go much
> further, do you have a copyright assignment on file the FSF.
> If not, please see https://gcc.gnu.org/contribute.html
>
> --
> steve
>
> On Wed, Jan 16, 2019 at 06:16:12PM -0600, Nathan Weeks wrote:
> > Hi all,
> >
> > To facilitate more complete Fortran 2018 failed images support, I'm
> > particularly interested in interested in seeing PR 87939 eventually
> > resolved (i.e., allow STAT= and ERRMSG= specifiers in FORM TEAM,
> > CHANGE TEAM, SYNC TEAM, END TEAM, and CRITICAL statements). To get the
> > ball rolling (I realize that the boat has been missed for this kind of
> > change in GCC 9 trunk), I've attempted the following patch (which,
> > since it was convenient to do while modifying FORM TEAM-related code,
> > also adds the NEW_INDEX= specifier to the FORM TEAM statement as
> > desired in PR 87326).
> >
> > This is the first gfortran patch I've attempted, and I certainly could
> > have made some noob mistakes, so verbose feedback would be
> > appreciated.
> >
> > A few comments:
> >
> > * In resolve.c, the newly-added functions that type check STAT= and
> > ERRMSG= arguments for FORM TEAM, CHANGE TEAM, and SYNC TEAM also add
> > (previously-absent) type checking for their TEAM_TYPE arguments. If
> > it's more appropriate, I could separate this change into its own PR.
> >
> > * The existing -fcoarray=lib implementation of CRITICAL acquires a
> > LOCK on a lock variable on image 1 (in the current team). However, a
> > CRITICAL statement stat-value of STAT_FAILED_IMAGE (i.e., the image
> > that enter the CRITICAL construct failed) is analogous to the LOCK
> > stat-value of STAT_UNLOCKED_FAILED_IMAGE (i.e., the image that
> > acquired the lock failed---see section 11.6.11 (7 & 10) in Fortran
> > 2018 draft N2146), whereas a LOCK STAT_FAILED_IMAGE means the image on
> > which the lock variable resides has failed (no analog in the CRITICAL
> > statement, which is oblivious to this underlying implementation). So
> > in addition to adding the stat value STAT_UNLOCKED_FAILED_IMAGE to
> > libgfortran.h & libcaf.h, I had CRITICAL swap a LOCK
> > STAT_UNLOCKED_FAILED_IMAGE for STAT_FAILED_IMAGE, and (perhaps
> > unimaginatively) a LOCK STAT_FAILED_IMAGE for
> > STAT_UNLOCKED_FAILED_IMAGE (which, while it has no defined meaning for
> > a CRITICAL statement, fits the definition of a "processor-dependent
> > value other than STAT_FAILED_IMAGE").
> >
> > * A couple negative tests for syntax errors (coarray_critical_2.f90 &
> > team_end_2.f90) fail due to spurious "Error: Expecting END PROGRAM
> > statement at (1)" errors that are also emitted by gfortran 8.2.0 as
> > well.
> >
> > Thanks,
> >
> > --
> > Nathan
> >
> > frontend:
> >
> > 2019-01-16  Nathan Weeks  <weeks@iastate.edu>
> >
> >         PR fortran/87939
> >         PR fortran/87326
> >         * gfortran.h: Add an additional gfc_expr member to struct
> gfc_code.
> >         * libcaf.h: Add support for STAT_UNLOCKED_FAILED_IMAGE.
> >         * match.c (gfc_match_critical): Add STAT= and ERRMSG=.
> >         (gfc_match_change_team): Likewise.
> >         (gfc_match_end_team): Likewise.
> >         (gfc_match_sync_team): Likewise.
> >         (gfc_match_form_team): Add STAT=, ERRMSG=, and NEW_INDEX=.
> >         * resolve.c (resolve_form_team): New. Type check team-variable
> > argument in
> >         addition to new STAT= and ERRMSG= arguments.
> >         (resolve_change_sync_team): New. Adds type checking for
> team-value
> >         argument.
> >         (resolve_end_team): New.
> >         (resolve_critical): Add STAT= and ERRMSG=.
> >         * trans-decl.c (gfc_build_builtin_function_decls): Additional
> stat,
> >         errmsg, and errmsg_len arguments to _gfortran_caf_form_team(),
> >         _gfortran_caf_change_team(), _gfortran_caf_end_team(), and
> >         _gfortran_caf_sync_team(), and additional new_index argument to
> >         _gfortran_caf_form_team().
> >         * trans-stmt.c (gfc_trans_form_team): Support STAT=, ERRMSG=, and
> >         NEW_INDEX=.
> >         (gfc_trans_change_team): Support STAT= and ERRMSG=.
> >         (gfc_trans_end_team): Likewise.
> >         (gfc_trans_sync_team): Likewise.
> >         (gfc_trans_critical): Likewise. Also support assigning
> STAT_FAILED_IMAGE
> >         to a stat-variable.
> >
> > libgfortran:
> >
> > 2019-01-16  Nathan Weeks  <weeks@iastate.edu>
> >
> >         PR fortran/87939
> >         * libgfortran.h: Add support for STAT_UNLOCKED_FAILED_IMAGE
> >
> > testsuite:
> >
> > 2019-01-16  Nathan Weeks  <weeks@iastate.edu>
> >
> >         PR fortran/87939
> >         PR fortran/87326
> >         * gfortran.dg/coarray_critical_2.f90: New test
> >         * gfortran.dg/coarray_critical_3.f90: New test
> >         * gfortran.dg/coarray_critical_4.f90: New test
> >         * gfortran.dg/team_change_2.f90: New test
> >         * gfortran.dg/team_change_3.f90: New test
> >         * gfortran.dg/team_end_2.f90: New test
> >         * gfortran.dg/team_end_3.f90: New test
> >         * gfortran.dg/team_form_2.f90: New test
> >         * gfortran.dg/team_form_3.f90: New test
> >         * gfortran.dg/team_sync_1.f90: New test
> >         * gfortran.dg/team_sync_2.f90: New test
>
>
>
> --
> Steve
> 20170425 https://www.youtube.com/watch?v=VWUpyCsUKR4
> 20161221 https://www.youtube.com/watch?v=IbCHE-hONow
>

Re: [PATCH,Fortran][RFC] PR 87939, 87326 - STAT= and ERRMSG= specifiers in several image control statements; NEW_INDEX= specifier in FORM TEAM statement

[Nathan Weeks]

I made a mistake in the ChangeLogs: libgfortran.h is in gcc/fortran,
and libcaf.h is in libgfortran/caf. Also, the additional enumerations
in those headers don't go all the way in adding support for
STAT_UNLOCKED_FAILED_IMAGE to ISO_FORTRAN_ENV itself (it looks like
that would be at least a minor modification to
gcc/fortran/iso-fortran-env.def, and documentation update in
gcc/fortran/intrinsic.texi, and perhaps a test). I've updated the
ChangeLogs to clarify all of this.

-- 
Nathan

frontend:

2019-01-16  Nathan Weeks  <weeks@iastate.edu>

        PR fortran/87939
        PR fortran/87326
        * gfortran.h: Add an additional gfc_expr member to struct gfc_code.
        * libgfortran.h: Add GFC_STAT_UNLOCKED_FAILED_IMAGE.
        * match.c (gfc_match_critical): Add STAT= and ERRMSG=.
        (gfc_match_change_team): Likewise.
        (gfc_match_end_team): Likewise.
        (gfc_match_sync_team): Likewise.
        (gfc_match_form_team): Add STAT=, ERRMSG=, and NEW_INDEX=.
        * resolve.c (resolve_form_team): New. Type check team-variable
argument in
        addition to new STAT= and ERRMSG= arguments.
        (resolve_change_sync_team): New. Adds type checking for team-value
        argument.
        (resolve_end_team): New.
        (resolve_critical): Add STAT= and ERRMSG=.
        * trans-decl.c (gfc_build_builtin_function_decls): Additional stat,
        errmsg, and errmsg_len arguments to _gfortran_caf_form_team(),
        _gfortran_caf_change_team(), _gfortran_caf_end_team(), and
        _gfortran_caf_sync_team(), and additional new_index argument to
        _gfortran_caf_form_team().
        * trans-stmt.c (gfc_trans_form_team): Support STAT=, ERRMSG=, and
        NEW_INDEX=.
        (gfc_trans_change_team): Support STAT= and ERRMSG=.
        (gfc_trans_end_team): Likewise.
        (gfc_trans_sync_team): Likewise.
        (gfc_trans_critical): Likewise. Also support assigning STAT_FAILED_IMAGE
        to a stat-variable.

libgfortran:

2019-01-16  Nathan Weeks  <weeks@iastate.edu>

        PR fortran/87939
        * caf/libcaf.h: Add CAF_STAT_FAILED_IMAGE.

testsuite:

2019-01-16  Nathan Weeks  <weeks@iastate.edu>

        PR fortran/87939
        PR fortran/87326
        * gfortran.dg/coarray_critical_2.f90: New test
        * gfortran.dg/coarray_critical_3.f90: New test
        * gfortran.dg/coarray_critical_4.f90: New test
        * gfortran.dg/team_change_2.f90: New test
        * gfortran.dg/team_change_3.f90: New test
        * gfortran.dg/team_end_2.f90: New test
        * gfortran.dg/team_end_3.f90: New test
        * gfortran.dg/team_form_2.f90: New test
        * gfortran.dg/team_form_3.f90: New test
        * gfortran.dg/team_sync_1.f90: New test
        * gfortran.dg/team_sync_2.f90: New test

--
Nathan

On Wed, Jan 16, 2019 at 6:16 PM Nathan Weeks <weeks@iastate.edu> wrote:
>
> Hi all,
>
> To facilitate more complete Fortran 2018 failed images support, I'm
> particularly interested in interested in seeing PR 87939 eventually
> resolved (i.e., allow STAT= and ERRMSG= specifiers in FORM TEAM,
> CHANGE TEAM, SYNC TEAM, END TEAM, and CRITICAL statements). To get the
> ball rolling (I realize that the boat has been missed for this kind of
> change in GCC 9 trunk), I've attempted the following patch (which,
> since it was convenient to do while modifying FORM TEAM-related code,
> also adds the NEW_INDEX= specifier to the FORM TEAM statement as
> desired in PR 87326).
>
> This is the first gfortran patch I've attempted, and I certainly could
> have made some noob mistakes, so verbose feedback would be
> appreciated.
>
> A few comments:
>
> * In resolve.c, the newly-added functions that type check STAT= and
> ERRMSG= arguments for FORM TEAM, CHANGE TEAM, and SYNC TEAM also add
> (previously-absent) type checking for their TEAM_TYPE arguments. If
> it's more appropriate, I could separate this change into its own PR.
>
> * The existing -fcoarray=lib implementation of CRITICAL acquires a
> LOCK on a lock variable on image 1 (in the current team). However, a
> CRITICAL statement stat-value of STAT_FAILED_IMAGE (i.e., the image
> that enter the CRITICAL construct failed) is analogous to the LOCK
> stat-value of STAT_UNLOCKED_FAILED_IMAGE (i.e., the image that
> acquired the lock failed---see section 11.6.11 (7 & 10) in Fortran
> 2018 draft N2146), whereas a LOCK STAT_FAILED_IMAGE means the image on
> which the lock variable resides has failed (no analog in the CRITICAL
> statement, which is oblivious to this underlying implementation). So
> in addition to adding the stat value STAT_UNLOCKED_FAILED_IMAGE to
> libgfortran.h & libcaf.h, I had CRITICAL swap a LOCK
> STAT_UNLOCKED_FAILED_IMAGE for STAT_FAILED_IMAGE, and (perhaps
> unimaginatively) a LOCK STAT_FAILED_IMAGE for
> STAT_UNLOCKED_FAILED_IMAGE (which, while it has no defined meaning for
> a CRITICAL statement, fits the definition of a "processor-dependent
> value other than STAT_FAILED_IMAGE").
>
> * A couple negative tests for syntax errors (coarray_critical_2.f90 &
> team_end_2.f90) fail due to spurious "Error: Expecting END PROGRAM
> statement at (1)" errors that are also emitted by gfortran 8.2.0 as
> well.
>
> Thanks,
>
> --
> Nathan
>
> frontend:
>
> 2019-01-16  Nathan Weeks  <weeks@iastate.edu>
>
>         PR fortran/87939
>         PR fortran/87326
>         * gfortran.h: Add an additional gfc_expr member to struct gfc_code.
>         * libcaf.h: Add support for STAT_UNLOCKED_FAILED_IMAGE.
>         * match.c (gfc_match_critical): Add STAT= and ERRMSG=.
>         (gfc_match_change_team): Likewise.
>         (gfc_match_end_team): Likewise.
>         (gfc_match_sync_team): Likewise.
>         (gfc_match_form_team): Add STAT=, ERRMSG=, and NEW_INDEX=.
>         * resolve.c (resolve_form_team): New. Type check team-variable
> argument in
>         addition to new STAT= and ERRMSG= arguments.
>         (resolve_change_sync_team): New. Adds type checking for team-value
>         argument.
>         (resolve_end_team): New.
>         (resolve_critical): Add STAT= and ERRMSG=.
>         * trans-decl.c (gfc_build_builtin_function_decls): Additional stat,
>         errmsg, and errmsg_len arguments to _gfortran_caf_form_team(),
>         _gfortran_caf_change_team(), _gfortran_caf_end_team(), and
>         _gfortran_caf_sync_team(), and additional new_index argument to
>         _gfortran_caf_form_team().
>         * trans-stmt.c (gfc_trans_form_team): Support STAT=, ERRMSG=, and
>         NEW_INDEX=.
>         (gfc_trans_change_team): Support STAT= and ERRMSG=.
>         (gfc_trans_end_team): Likewise.
>         (gfc_trans_sync_team): Likewise.
>         (gfc_trans_critical): Likewise. Also support assigning STAT_FAILED_IMAGE
>         to a stat-variable.
>
> libgfortran:
>
> 2019-01-16  Nathan Weeks  <weeks@iastate.edu>
>
>         PR fortran/87939
>         * libgfortran.h: Add support for STAT_UNLOCKED_FAILED_IMAGE
>
> testsuite:
>
> 2019-01-16  Nathan Weeks  <weeks@iastate.edu>
>
>         PR fortran/87939
>         PR fortran/87326
>         * gfortran.dg/coarray_critical_2.f90: New test
>         * gfortran.dg/coarray_critical_3.f90: New test
>         * gfortran.dg/coarray_critical_4.f90: New test
>         * gfortran.dg/team_change_2.f90: New test
>         * gfortran.dg/team_change_3.f90: New test
>         * gfortran.dg/team_end_2.f90: New test
>         * gfortran.dg/team_end_3.f90: New test
>         * gfortran.dg/team_form_2.f90: New test
>         * gfortran.dg/team_form_3.f90: New test
>         * gfortran.dg/team_sync_1.f90: New test
>         * gfortran.dg/team_sync_2.f90: New test

Re: [PATCH,Fortran][RFC] PR 87939, 87326 - STAT= and ERRMSG= specifiers in several image control statements; NEW_INDEX= specifier in FORM TEAM statement

[Steve Kargl]

Nathan,

Can you add URLs in the bug reports to your patch so
that it doesn't get lost?  The copyright assignment
can take longer than one might think.

-- 
steve

On Fri, Jan 18, 2019 at 01:17:03PM -0600, Nathan Weeks wrote:
> I made a mistake in the ChangeLogs: libgfortran.h is in gcc/fortran,
> and libcaf.h is in libgfortran/caf. Also, the additional enumerations
> in those headers don't go all the way in adding support for
> STAT_UNLOCKED_FAILED_IMAGE to ISO_FORTRAN_ENV itself (it looks like
> that would be at least a minor modification to
> gcc/fortran/iso-fortran-env.def, and documentation update in
> gcc/fortran/intrinsic.texi, and perhaps a test). I've updated the
> ChangeLogs to clarify all of this.
> 
> -- 
> Nathan
> 
> frontend:
> 
> 2019-01-16  Nathan Weeks  <weeks@iastate.edu>
> 
>         PR fortran/87939
>         PR fortran/87326
>         * gfortran.h: Add an additional gfc_expr member to struct gfc_code.
>         * libgfortran.h: Add GFC_STAT_UNLOCKED_FAILED_IMAGE.
>         * match.c (gfc_match_critical): Add STAT= and ERRMSG=.
>         (gfc_match_change_team): Likewise.
>         (gfc_match_end_team): Likewise.
>         (gfc_match_sync_team): Likewise.
>         (gfc_match_form_team): Add STAT=, ERRMSG=, and NEW_INDEX=.
>         * resolve.c (resolve_form_team): New. Type check team-variable
> argument in
>         addition to new STAT= and ERRMSG= arguments.
>         (resolve_change_sync_team): New. Adds type checking for team-value
>         argument.
>         (resolve_end_team): New.
>         (resolve_critical): Add STAT= and ERRMSG=.
>         * trans-decl.c (gfc_build_builtin_function_decls): Additional stat,
>         errmsg, and errmsg_len arguments to _gfortran_caf_form_team(),
>         _gfortran_caf_change_team(), _gfortran_caf_end_team(), and
>         _gfortran_caf_sync_team(), and additional new_index argument to
>         _gfortran_caf_form_team().
>         * trans-stmt.c (gfc_trans_form_team): Support STAT=, ERRMSG=, and
>         NEW_INDEX=.
>         (gfc_trans_change_team): Support STAT= and ERRMSG=.
>         (gfc_trans_end_team): Likewise.
>         (gfc_trans_sync_team): Likewise.
>         (gfc_trans_critical): Likewise. Also support assigning STAT_FAILED_IMAGE
>         to a stat-variable.
> 
> libgfortran:
> 
> 2019-01-16  Nathan Weeks  <weeks@iastate.edu>
> 
>         PR fortran/87939
>         * caf/libcaf.h: Add CAF_STAT_FAILED_IMAGE.
> 
> testsuite:
> 
> 2019-01-16  Nathan Weeks  <weeks@iastate.edu>
> 
>         PR fortran/87939
>         PR fortran/87326
>         * gfortran.dg/coarray_critical_2.f90: New test
>         * gfortran.dg/coarray_critical_3.f90: New test
>         * gfortran.dg/coarray_critical_4.f90: New test
>         * gfortran.dg/team_change_2.f90: New test
>         * gfortran.dg/team_change_3.f90: New test
>         * gfortran.dg/team_end_2.f90: New test
>         * gfortran.dg/team_end_3.f90: New test
>         * gfortran.dg/team_form_2.f90: New test
>         * gfortran.dg/team_form_3.f90: New test
>         * gfortran.dg/team_sync_1.f90: New test
>         * gfortran.dg/team_sync_2.f90: New test
> 
> --
> Nathan
> 
> On Wed, Jan 16, 2019 at 6:16 PM Nathan Weeks <weeks@iastate.edu> wrote:
> >
> > Hi all,
> >
> > To facilitate more complete Fortran 2018 failed images support, I'm
> > particularly interested in interested in seeing PR 87939 eventually
> > resolved (i.e., allow STAT= and ERRMSG= specifiers in FORM TEAM,
> > CHANGE TEAM, SYNC TEAM, END TEAM, and CRITICAL statements). To get the
> > ball rolling (I realize that the boat has been missed for this kind of
> > change in GCC 9 trunk), I've attempted the following patch (which,
> > since it was convenient to do while modifying FORM TEAM-related code,
> > also adds the NEW_INDEX= specifier to the FORM TEAM statement as
> > desired in PR 87326).
> >
> > This is the first gfortran patch I've attempted, and I certainly could
> > have made some noob mistakes, so verbose feedback would be
> > appreciated.
> >
> > A few comments:
> >
> > * In resolve.c, the newly-added functions that type check STAT= and
> > ERRMSG= arguments for FORM TEAM, CHANGE TEAM, and SYNC TEAM also add
> > (previously-absent) type checking for their TEAM_TYPE arguments. If
> > it's more appropriate, I could separate this change into its own PR.
> >
> > * The existing -fcoarray=lib implementation of CRITICAL acquires a
> > LOCK on a lock variable on image 1 (in the current team). However, a
> > CRITICAL statement stat-value of STAT_FAILED_IMAGE (i.e., the image
> > that enter the CRITICAL construct failed) is analogous to the LOCK
> > stat-value of STAT_UNLOCKED_FAILED_IMAGE (i.e., the image that
> > acquired the lock failed---see section 11.6.11 (7 & 10) in Fortran
> > 2018 draft N2146), whereas a LOCK STAT_FAILED_IMAGE means the image on
> > which the lock variable resides has failed (no analog in the CRITICAL
> > statement, which is oblivious to this underlying implementation). So
> > in addition to adding the stat value STAT_UNLOCKED_FAILED_IMAGE to
> > libgfortran.h & libcaf.h, I had CRITICAL swap a LOCK
> > STAT_UNLOCKED_FAILED_IMAGE for STAT_FAILED_IMAGE, and (perhaps
> > unimaginatively) a LOCK STAT_FAILED_IMAGE for
> > STAT_UNLOCKED_FAILED_IMAGE (which, while it has no defined meaning for
> > a CRITICAL statement, fits the definition of a "processor-dependent
> > value other than STAT_FAILED_IMAGE").
> >
> > * A couple negative tests for syntax errors (coarray_critical_2.f90 &
> > team_end_2.f90) fail due to spurious "Error: Expecting END PROGRAM
> > statement at (1)" errors that are also emitted by gfortran 8.2.0 as
> > well.
> >
> > Thanks,
> >
> > --
> > Nathan
> >
> > frontend:
> >
> > 2019-01-16  Nathan Weeks  <weeks@iastate.edu>
> >
> >         PR fortran/87939
> >         PR fortran/87326
> >         * gfortran.h: Add an additional gfc_expr member to struct gfc_code.
> >         * libcaf.h: Add support for STAT_UNLOCKED_FAILED_IMAGE.
> >         * match.c (gfc_match_critical): Add STAT= and ERRMSG=.
> >         (gfc_match_change_team): Likewise.
> >         (gfc_match_end_team): Likewise.
> >         (gfc_match_sync_team): Likewise.
> >         (gfc_match_form_team): Add STAT=, ERRMSG=, and NEW_INDEX=.
> >         * resolve.c (resolve_form_team): New. Type check team-variable
> > argument in
> >         addition to new STAT= and ERRMSG= arguments.
> >         (resolve_change_sync_team): New. Adds type checking for team-value
> >         argument.
> >         (resolve_end_team): New.
> >         (resolve_critical): Add STAT= and ERRMSG=.
> >         * trans-decl.c (gfc_build_builtin_function_decls): Additional stat,
> >         errmsg, and errmsg_len arguments to _gfortran_caf_form_team(),
> >         _gfortran_caf_change_team(), _gfortran_caf_end_team(), and
> >         _gfortran_caf_sync_team(), and additional new_index argument to
> >         _gfortran_caf_form_team().
> >         * trans-stmt.c (gfc_trans_form_team): Support STAT=, ERRMSG=, and
> >         NEW_INDEX=.
> >         (gfc_trans_change_team): Support STAT= and ERRMSG=.
> >         (gfc_trans_end_team): Likewise.
> >         (gfc_trans_sync_team): Likewise.
> >         (gfc_trans_critical): Likewise. Also support assigning STAT_FAILED_IMAGE
> >         to a stat-variable.
> >
> > libgfortran:
> >
> > 2019-01-16  Nathan Weeks  <weeks@iastate.edu>
> >
> >         PR fortran/87939
> >         * libgfortran.h: Add support for STAT_UNLOCKED_FAILED_IMAGE
> >
> > testsuite:
> >
> > 2019-01-16  Nathan Weeks  <weeks@iastate.edu>
> >
> >         PR fortran/87939
> >         PR fortran/87326
> >         * gfortran.dg/coarray_critical_2.f90: New test
> >         * gfortran.dg/coarray_critical_3.f90: New test
> >         * gfortran.dg/coarray_critical_4.f90: New test
> >         * gfortran.dg/team_change_2.f90: New test
> >         * gfortran.dg/team_change_3.f90: New test
> >         * gfortran.dg/team_end_2.f90: New test
> >         * gfortran.dg/team_end_3.f90: New test
> >         * gfortran.dg/team_form_2.f90: New test
> >         * gfortran.dg/team_form_3.f90: New test
> >         * gfortran.dg/team_sync_1.f90: New test
> >         * gfortran.dg/team_sync_2.f90: New test

-- 
Steve
20170425 https://www.youtube.com/watch?v=VWUpyCsUKR4
20161221 https://www.youtube.com/watch?v=IbCHE-hONow

Re: [PATCH,Fortran][RFC] PR 87939, 87326 - STAT= and ERRMSG= specifiers in several image control statements; NEW_INDEX= specifier in FORM TEAM statement

[Nathan Weeks]

Hi Steve,

URLs: done
Copyright assignment: in progress. Thanks for the heads up regarding the wait.

--
Nathan

On Fri, Jan 18, 2019 at 1:27 PM Steve Kargl
<sgk@troutmask.apl.washington.edu> wrote:
>
> Nathan,
>
> Can you add URLs in the bug reports to your patch so
> that it doesn't get lost?  The copyright assignment
> can take longer than one might think.
>
> --
> steve
>
> On Fri, Jan 18, 2019 at 01:17:03PM -0600, Nathan Weeks wrote:
> > I made a mistake in the ChangeLogs: libgfortran.h is in gcc/fortran,
> > and libcaf.h is in libgfortran/caf. Also, the additional enumerations
> > in those headers don't go all the way in adding support for
> > STAT_UNLOCKED_FAILED_IMAGE to ISO_FORTRAN_ENV itself (it looks like
> > that would be at least a minor modification to
> > gcc/fortran/iso-fortran-env.def, and documentation update in
> > gcc/fortran/intrinsic.texi, and perhaps a test). I've updated the
> > ChangeLogs to clarify all of this.
> >
> > --
> > Nathan
> >
> > frontend:
> >
> > 2019-01-16  Nathan Weeks  <weeks@iastate.edu>
> >
> >         PR fortran/87939
> >         PR fortran/87326
> >         * gfortran.h: Add an additional gfc_expr member to struct gfc_code.
> >         * libgfortran.h: Add GFC_STAT_UNLOCKED_FAILED_IMAGE.
> >         * match.c (gfc_match_critical): Add STAT= and ERRMSG=.
> >         (gfc_match_change_team): Likewise.
> >         (gfc_match_end_team): Likewise.
> >         (gfc_match_sync_team): Likewise.
> >         (gfc_match_form_team): Add STAT=, ERRMSG=, and NEW_INDEX=.
> >         * resolve.c (resolve_form_team): New. Type check team-variable
> > argument in
> >         addition to new STAT= and ERRMSG= arguments.
> >         (resolve_change_sync_team): New. Adds type checking for team-value
> >         argument.
> >         (resolve_end_team): New.
> >         (resolve_critical): Add STAT= and ERRMSG=.
> >         * trans-decl.c (gfc_build_builtin_function_decls): Additional stat,
> >         errmsg, and errmsg_len arguments to _gfortran_caf_form_team(),
> >         _gfortran_caf_change_team(), _gfortran_caf_end_team(), and
> >         _gfortran_caf_sync_team(), and additional new_index argument to
> >         _gfortran_caf_form_team().
> >         * trans-stmt.c (gfc_trans_form_team): Support STAT=, ERRMSG=, and
> >         NEW_INDEX=.
> >         (gfc_trans_change_team): Support STAT= and ERRMSG=.
> >         (gfc_trans_end_team): Likewise.
> >         (gfc_trans_sync_team): Likewise.
> >         (gfc_trans_critical): Likewise. Also support assigning STAT_FAILED_IMAGE
> >         to a stat-variable.
> >
> > libgfortran:
> >
> > 2019-01-16  Nathan Weeks  <weeks@iastate.edu>
> >
> >         PR fortran/87939
> >         * caf/libcaf.h: Add CAF_STAT_FAILED_IMAGE.
> >
> > testsuite:
> >
> > 2019-01-16  Nathan Weeks  <weeks@iastate.edu>
> >
> >         PR fortran/87939
> >         PR fortran/87326
> >         * gfortran.dg/coarray_critical_2.f90: New test
> >         * gfortran.dg/coarray_critical_3.f90: New test
> >         * gfortran.dg/coarray_critical_4.f90: New test
> >         * gfortran.dg/team_change_2.f90: New test
> >         * gfortran.dg/team_change_3.f90: New test
> >         * gfortran.dg/team_end_2.f90: New test
> >         * gfortran.dg/team_end_3.f90: New test
> >         * gfortran.dg/team_form_2.f90: New test
> >         * gfortran.dg/team_form_3.f90: New test
> >         * gfortran.dg/team_sync_1.f90: New test
> >         * gfortran.dg/team_sync_2.f90: New test
> >
> > --
> > Nathan
> >
> > On Wed, Jan 16, 2019 at 6:16 PM Nathan Weeks <weeks@iastate.edu> wrote:
> > >
> > > Hi all,
> > >
> > > To facilitate more complete Fortran 2018 failed images support, I'm
> > > particularly interested in interested in seeing PR 87939 eventually
> > > resolved (i.e., allow STAT= and ERRMSG= specifiers in FORM TEAM,
> > > CHANGE TEAM, SYNC TEAM, END TEAM, and CRITICAL statements). To get the
> > > ball rolling (I realize that the boat has been missed for this kind of
> > > change in GCC 9 trunk), I've attempted the following patch (which,
> > > since it was convenient to do while modifying FORM TEAM-related code,
> > > also adds the NEW_INDEX= specifier to the FORM TEAM statement as
> > > desired in PR 87326).
> > >
> > > This is the first gfortran patch I've attempted, and I certainly could
> > > have made some noob mistakes, so verbose feedback would be
> > > appreciated.
> > >
> > > A few comments:
> > >
> > > * In resolve.c, the newly-added functions that type check STAT= and
> > > ERRMSG= arguments for FORM TEAM, CHANGE TEAM, and SYNC TEAM also add
> > > (previously-absent) type checking for their TEAM_TYPE arguments. If
> > > it's more appropriate, I could separate this change into its own PR.
> > >
> > > * The existing -fcoarray=lib implementation of CRITICAL acquires a
> > > LOCK on a lock variable on image 1 (in the current team). However, a
> > > CRITICAL statement stat-value of STAT_FAILED_IMAGE (i.e., the image
> > > that enter the CRITICAL construct failed) is analogous to the LOCK
> > > stat-value of STAT_UNLOCKED_FAILED_IMAGE (i.e., the image that
> > > acquired the lock failed---see section 11.6.11 (7 & 10) in Fortran
> > > 2018 draft N2146), whereas a LOCK STAT_FAILED_IMAGE means the image on
> > > which the lock variable resides has failed (no analog in the CRITICAL
> > > statement, which is oblivious to this underlying implementation). So
> > > in addition to adding the stat value STAT_UNLOCKED_FAILED_IMAGE to
> > > libgfortran.h & libcaf.h, I had CRITICAL swap a LOCK
> > > STAT_UNLOCKED_FAILED_IMAGE for STAT_FAILED_IMAGE, and (perhaps
> > > unimaginatively) a LOCK STAT_FAILED_IMAGE for
> > > STAT_UNLOCKED_FAILED_IMAGE (which, while it has no defined meaning for
> > > a CRITICAL statement, fits the definition of a "processor-dependent
> > > value other than STAT_FAILED_IMAGE").
> > >
> > > * A couple negative tests for syntax errors (coarray_critical_2.f90 &
> > > team_end_2.f90) fail due to spurious "Error: Expecting END PROGRAM
> > > statement at (1)" errors that are also emitted by gfortran 8.2.0 as
> > > well.
> > >
> > > Thanks,
> > >
> > > --
> > > Nathan
> > >
> > > frontend:
> > >
> > > 2019-01-16  Nathan Weeks  <weeks@iastate.edu>
> > >
> > >         PR fortran/87939
> > >         PR fortran/87326
> > >         * gfortran.h: Add an additional gfc_expr member to struct gfc_code.
> > >         * libcaf.h: Add support for STAT_UNLOCKED_FAILED_IMAGE.
> > >         * match.c (gfc_match_critical): Add STAT= and ERRMSG=.
> > >         (gfc_match_change_team): Likewise.
> > >         (gfc_match_end_team): Likewise.
> > >         (gfc_match_sync_team): Likewise.
> > >         (gfc_match_form_team): Add STAT=, ERRMSG=, and NEW_INDEX=.
> > >         * resolve.c (resolve_form_team): New. Type check team-variable
> > > argument in
> > >         addition to new STAT= and ERRMSG= arguments.
> > >         (resolve_change_sync_team): New. Adds type checking for team-value
> > >         argument.
> > >         (resolve_end_team): New.
> > >         (resolve_critical): Add STAT= and ERRMSG=.
> > >         * trans-decl.c (gfc_build_builtin_function_decls): Additional stat,
> > >         errmsg, and errmsg_len arguments to _gfortran_caf_form_team(),
> > >         _gfortran_caf_change_team(), _gfortran_caf_end_team(), and
> > >         _gfortran_caf_sync_team(), and additional new_index argument to
> > >         _gfortran_caf_form_team().
> > >         * trans-stmt.c (gfc_trans_form_team): Support STAT=, ERRMSG=, and
> > >         NEW_INDEX=.
> > >         (gfc_trans_change_team): Support STAT= and ERRMSG=.
> > >         (gfc_trans_end_team): Likewise.
> > >         (gfc_trans_sync_team): Likewise.
> > >         (gfc_trans_critical): Likewise. Also support assigning STAT_FAILED_IMAGE
> > >         to a stat-variable.
> > >
> > > libgfortran:
> > >
> > > 2019-01-16  Nathan Weeks  <weeks@iastate.edu>
> > >
> > >         PR fortran/87939
> > >         * libgfortran.h: Add support for STAT_UNLOCKED_FAILED_IMAGE
> > >
> > > testsuite:
> > >
> > > 2019-01-16  Nathan Weeks  <weeks@iastate.edu>
> > >
> > >         PR fortran/87939
> > >         PR fortran/87326
> > >         * gfortran.dg/coarray_critical_2.f90: New test
> > >         * gfortran.dg/coarray_critical_3.f90: New test
> > >         * gfortran.dg/coarray_critical_4.f90: New test
> > >         * gfortran.dg/team_change_2.f90: New test
> > >         * gfortran.dg/team_change_3.f90: New test
> > >         * gfortran.dg/team_end_2.f90: New test
> > >         * gfortran.dg/team_end_3.f90: New test
> > >         * gfortran.dg/team_form_2.f90: New test
> > >         * gfortran.dg/team_form_3.f90: New test
> > >         * gfortran.dg/team_sync_1.f90: New test
> > >         * gfortran.dg/team_sync_2.f90: New test
>
> --
> Steve
> 20170425 https://www.youtube.com/watch?v=VWUpyCsUKR4
> 20161221 https://www.youtube.com/watch?v=IbCHE-hONow