Fortran: Unify handling of STAT= and ERRMSG= optional arguments [PR87939]

In preparing F2018 Teams handling improvements, unify handling of STAT=
and ERRMSG= optional arguments.  Handling of stat and errmsg in most
teams statements is corrected in the next patch.

Implement stat and errmsg for move_alloc () to comply with F2018.

	PR fortran/87939

gcc/fortran/ChangeLog:

	* check.cc (gfc_check_move_alloc): Add stat and errmsg to
	move_alloc.
	* dump-parse-tree.cc (show_sync_stat): New helper function.
	(show_code_node): Use show_sync_stat to print stat and errmsg.
	* gfortran.h (struct sync_stat): New struct to unify stat and
	errmsg handling.
	* intrinsic.cc (add_subroutines): Correct signature of
	move_alloc.
	* intrinsic.h (gfc_check_move_alloc): Correct signature of
	check_move_alloc.
	* match.cc (match_named_arg): Match an optional argument to a
	statement.
	(match_stat_errmsg): Match a stat= or errmsg= named argument.
	(gfc_match_critical): Use match_stat_errmsg to match the named
	arguments.
	(gfc_match_sync_team): Same.
	* resolve.cc (resolve_team_argument): Resolve an expr to have
	type TEAM_TYPE from iso_fortran_env.
	(resolve_scalar_variable_as_arg): Resolve an argument as a
	scalar type.
	(resolve_sync_stat): Resolve stat and errmsg expressions.
	(resolve_sync_team): Resolve a sync team statement using
	sync_stat helper.
	(resolve_end_team): Same.
	(resolve_critical): Same.
	* trans-decl.cc (gfc_build_builtin_function_decls): Correct
	sync_team signature.
	* trans-intrinsic.cc (conv_intrinsic_move_alloc): Store stat
	an errmsg optional arguments in helper struct and use helper
	to translate.
	* trans-stmt.cc (trans_exit): Implement DRY pattern for
	generating an _exit().
	(gfc_trans_sync_stat): Translate stat and errmsg contents.
	(gfc_trans_end_team): Use helper to translate stat and errmsg.
	(gfc_trans_sync_team): Same.
	(gfc_trans_critical): Same.
	* trans-stmt.h (gfc_trans_sync_stat): New function.
	* trans.cc (gfc_deallocate_with_status): Parameterize check at
	runtime to allow unallocated (co-)array when freeing a
	structure.
	(gfc_deallocate_scalar_with_status): Same and also add errmsg.
	* trans.h (gfc_deallocate_with_status): Signature changes.
	(gfc_deallocate_scalar_with_status): Same.

libgfortran/ChangeLog:

	* caf/single.c (_gfortran_caf_lock): Correct stat value, if
	lock is already locked by current image.
	(_gfortran_caf_unlock): Correct stat value, if lock is not
	locked.

gcc/testsuite/ChangeLog:

	* gfortran.dg/coarray_critical_2.f90: New test.
	* gfortran.dg/coarray_critical_3.f90: New test.
	* gfortran.dg/team_sync_1.f90: New test.
	* gfortran.dg/move_alloc_11.f90: New test.

1 files changed, 51 insertions, 1 deletions

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index f03708e..e9053b4 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -11484,6 +11484,53 @@ resolve_lock_unlock_event (gfc_code *code)
     }
 }
 
+static void
+resolve_team_argument (gfc_expr *team)
+{
+  gfc_resolve_expr (team);
+  if (team->rank != 0 || team->ts.type != BT_DERIVED
+      || team->ts.u.derived->from_intmod != INTMOD_ISO_FORTRAN_ENV
+      || team->ts.u.derived->intmod_sym_id != ISOFORTRAN_TEAM_TYPE)
+    {
+      gfc_error ("TEAM argument at %L must be a scalar expression "
+		 "of type TEAM_TYPE from the intrinsic module ISO_FORTRAN_ENV",
+		 &team->where);
+    }
+}
+
+static void
+resolve_scalar_variable_as_arg (const char *name, bt exp_type, int exp_kind,
+				gfc_expr *e)
+{
+  gfc_resolve_expr (e);
+  if (e
+      && (e->ts.type != exp_type || e->ts.kind < exp_kind || e->rank != 0
+	  || e->expr_type != EXPR_VARIABLE))
+    gfc_error ("%s argument at %L must be a scalar %s variable of at least "
+	       "kind %d", name, &e->where, gfc_basic_typename (exp_type),
+	       exp_kind);
+}
+
+void
+gfc_resolve_sync_stat (struct sync_stat *sync_stat)
+{
+  resolve_scalar_variable_as_arg ("STAT=", BT_INTEGER, 2, sync_stat->stat);
+  resolve_scalar_variable_as_arg ("ERRMSG=", BT_CHARACTER,
+				  gfc_default_character_kind,
+				  sync_stat->errmsg);
+}
+static void
+resolve_sync_team (gfc_code *code)
+{
+  resolve_team_argument (code->expr1);
+  gfc_resolve_sync_stat (&code->ext.sync_stat);
+}
+
+static void
+resolve_end_team (gfc_code *code)
+{
+  gfc_resolve_sync_stat (&code->ext.sync_stat);
+}
 
 static void
 resolve_critical (gfc_code *code)
@@ -11493,6 +11540,8 @@ resolve_critical (gfc_code *code)
   char name[GFC_MAX_SYMBOL_LEN];
   static int serial = 0;
 
+  gfc_resolve_sync_stat (&code->ext.sync_stat);
+
   if (flag_coarray != GFC_FCOARRAY_LIB)
     return;
 
@@ -13493,10 +13542,11 @@ start:
 	  break;
 
 	case EXEC_END_TEAM:
+	  resolve_end_team (code);
 	  break;
 
 	case EXEC_SYNC_TEAM:
-	  check_team (code->expr1, "SYNC TEAM");
+	  resolve_sync_team (code);
 	  break;
 
 	case EXEC_ENTRY: