check.c (gfc_check_event_query): New function.

2015-12-02  Tobias Burnus  <burnus@net-b.de>
	    Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>

	* check.c (gfc_check_event_query): New function.
	* dump-parse-tree.c (show_code_node): Handle EXEC_EVENT_POST,
	EXEC_EVENT_WAIT.
	* expr.c (gfc_check_vardef_context): New check for event variables
	definition.
	* gfortran.h (gfc_statement): Add ST_EVENT_POST, ST_EVENT_WAIT.
	(gfc_isym_id): GFC_ISYM_EVENT_QUERY.
	(struct symbol_attribute): New field.
	(gfc_exec_op): Add EXEC_EVENT_POST and EXEC_EVENT_WAIT.
	* gfortran.texi: Document about new events functions and minor
	changes.
	* interface.c (compare_parameter): New check.
	(gfc_procedure_use): New check for explicit procedure interface.
	(add_subroutines): Add event_query.
	* intrinsic.h (gfc_check_event_query,gfc_resolve_event_query):
	New prototypes.
	* iresolve.c (gfc_resolve_event_query): New function.
	* iso-fortran-env.def (event_type): New type.
	* match.c (event_statement,gfc_match_event_post,gfc_match_event_wait):
	New functions.
	(gfc_match_name): New event post and event wait.
	* match.h (gfc_match_event_post,gfc_match_event_wait):
	New prototypes.
	* module.c (ab_attribute): Add AB_EVENT_COMP.
	(attr_bits): Likewise.
	(mio_symbol_attribute): Handle event_comp attribute.
	* parse.c (decode_statement): Add ST_EVENT_POST, ST_EVENT_WAIT.
	(next_statement): Add ST_EVENT_POST, ST_EVENT_WAIT.
	(gfc_ascii_statement): Add ST_EVENT_POST, ST_EVENT_WAIT.
	(parse_derived): Check for event_type components.
	* resolve.c (resolve_allocate_expr): Check for event variable def.
	(resolve_lock_unlock): Renamed to resolve_lock_unlock_event. It
	includes logic for locks and events.
	(gfc_resolve_code): Call it.
	(gfc_resolve_symbol): New check for event variable to be a corray.
	* st.c (gfc_free_statement): Handle new EXEC_EVENT_POST and
	EXEC_EVENT_WAIT.
	* trans-decl.c (gfor_fndecl_caf_event_post,gfor_fndecl_caf_event_wait,
	gfor_fndecl_caf_event_query): New global variables.
	(generate_coarray_sym_init): Checking for event_type.
	(gfc_conv_procedure_call): Check for C bind attribute.
	* trans-intrinsic.c (conv_intrinsic_event_query): New function.
	(conv_intrinsic_move_alloc): Call it.
	* trans-stmt.c (gfc_trans_lock_unlock): Passing address
	of actual argument.
	(gfc_trans_sync): Likewise.
	(gfc_trans_event_post_wait): New function.
	* trans-stmt.h (gfc_trans_event_post_wait): New prototype.
	* trans-types.c (gfc_get_derived_type): Integer_kind as event_type.
	* trans.c (gfc_allocate_using_lib): New argument and logic for events.
	(gfc_allocate_allocatable): Passing new argument.
	(trans_code): Handle EXEC_EVENT_POST, EXEC_EVENT_WAIT.
	* trans.h (gfc_coarray_type): New elements.
	(gfor_fndecl_caf_event_post,gfor_fndecl_caf_event_wait,
	gfor_fndecl_caf_event_query): Declare them.

2015-12-02  Tobias Burnus  <burnus@net-b.de>
	    Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>

	* gfortran.dg/coarray/event_1.f90: New.
	* gfortran.dg/coarray/event_2.f90: New.

Co-Authored-By: Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>

From-SVN: r231208

1 files changed, 53 insertions, 0 deletions

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 038ee21..6dc7f3e 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -1157,6 +1157,59 @@ gfc_check_atomic_cas (gfc_expr *atom, gfc_expr *old, gfc_expr *compare,
   return true;
 }
 
+bool
+gfc_check_event_query (gfc_expr *event, gfc_expr *count, gfc_expr *stat)
+{
+  if (event->ts.type != BT_DERIVED
+      || event->ts.u.derived->from_intmod != INTMOD_ISO_FORTRAN_ENV
+      || event->ts.u.derived->intmod_sym_id != ISOFORTRAN_EVENT_TYPE)
+    {
+      gfc_error ("EVENT argument at %L to the intrinsic EVENT_QUERY "
+		 "shall be of type EVENT_TYPE", &event->where);
+      return false;
+    }
+
+  if (!scalar_check (event, 0))
+    return false;
+
+  if (!gfc_check_vardef_context (count, false, false, false, NULL))
+    {
+      gfc_error ("COUNT argument of the EVENT_QUERY intrinsic function at %L "
+		 "shall be definable", &count->where);
+      return false;
+    }
+
+  if (!type_check (count, 1, BT_INTEGER))
+    return false;
+
+  int i = gfc_validate_kind (BT_INTEGER, count->ts.kind, false);
+  int j = gfc_validate_kind (BT_INTEGER, gfc_default_integer_kind, false);
+
+  if (gfc_integer_kinds[i].range < gfc_integer_kinds[j].range)
+    {
+      gfc_error ("COUNT argument of the EVENT_QUERY intrinsic function at %L "
+		 "shall have at least the range of the default integer",
+		 &count->where);
+      return false;
+    }
+
+  if (stat != NULL)
+    {
+      if (!type_check (stat, 2, BT_INTEGER))
+	return false;
+      if (!scalar_check (stat, 2))
+	return false;
+      if (!variable_check (stat, 2, false))
+	return false;
+
+      if (!gfc_notify_std (GFC_STD_F2008_TS, "STAT= argument to %s at %L",
+			   gfc_current_intrinsic, &stat->where))
+	return false;
+    }
+
+  return true;
+}
+
 
 bool
 gfc_check_atomic_fetch_op (gfc_expr *atom, gfc_expr *value, gfc_expr *old,