From 1be1970f97d05a07851cd826132fcf466827ebe5 Mon Sep 17 00:00:00 2001
From: Andre Vehreschild <vehre@gcc.gnu.org>
Date: Fri, 14 Mar 2025 14:20:18 +0100
Subject: 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.
---
 gcc/fortran/dump-parse-tree.cc | 23 +++++++++++++++++++++--
 1 file changed, 21 insertions(+), 2 deletions(-)

(limited to 'gcc/fortran/dump-parse-tree.cc')

diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc
index 9501bcc..4ace093 100644
--- a/gcc/fortran/dump-parse-tree.cc
+++ b/gcc/fortran/dump-parse-tree.cc
@@ -2607,6 +2607,20 @@ show_omp_node (int level, gfc_code *c)
     fprintf (dumpfile, " (%s)", c->ext.omp_clauses->critical_name);
 }
 
+static void
+show_sync_stat (struct sync_stat *sync_stat)
+{
+  if (sync_stat->stat)
+    {
+      fputs (" stat=", dumpfile);
+      show_expr (sync_stat->stat);
+    }
+  if (sync_stat->errmsg)
+    {
+      fputs (" errmsg=", dumpfile);
+      show_expr (sync_stat->errmsg);
+    }
+}
 
 /* Show a single code node and everything underneath it if necessary.  */
 
@@ -2761,6 +2775,7 @@ show_code_node (int level, gfc_code *c)
 
     case EXEC_END_TEAM:
       fputs ("END TEAM", dumpfile);
+      show_sync_stat (&c->ext.sync_stat);
       break;
 
     case EXEC_FORM_TEAM:
@@ -2768,7 +2783,9 @@ show_code_node (int level, gfc_code *c)
       break;
 
     case EXEC_SYNC_TEAM:
-      fputs ("SYNC TEAM", dumpfile);
+      fputs ("SYNC TEAM ", dumpfile);
+      show_expr (c->expr1);
+      show_sync_stat (&c->ext.sync_stat);
       break;
 
     case EXEC_SYNC_ALL:
@@ -3048,7 +3065,9 @@ show_code_node (int level, gfc_code *c)
       break;
 
     case EXEC_CRITICAL:
-      fputs ("CRITICAL\n", dumpfile);
+      fputs ("CRITICAL", dumpfile);
+      show_sync_stat (&c->ext.sync_stat);
+      fputc ('\n', dumpfile);
       show_code (level + 1, c->block->next);
       code_indent (level, 0);
       fputs ("END CRITICAL", dumpfile);
-- 
cgit v1.1