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, 66 insertions, 3 deletions

diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index b2d15a8..157dea8 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -477,6 +477,8 @@ decode_statement (void)
       match ("entry% ", gfc_match_entry, ST_ENTRY);
       match ("equivalence", gfc_match_equivalence, ST_EQUIVALENCE);
       match ("external", gfc_match_external, ST_ATTR_DECL);
+      match ("event post", gfc_match_event_post, ST_EVENT_POST);
+      match ("event wait", gfc_match_event_wait, ST_EVENT_WAIT);
       break;
 
     case 'f':
@@ -1348,6 +1350,7 @@ next_statement (void)
   case ST_OMP_CANCEL: case ST_OMP_CANCELLATION_POINT: \
   case ST_OMP_TARGET_UPDATE: case ST_ERROR_STOP: case ST_SYNC_ALL: \
   case ST_SYNC_IMAGES: case ST_SYNC_MEMORY: case ST_LOCK: case ST_UNLOCK: \
+  case ST_EVENT_POST: case ST_EVENT_WAIT: \
   case ST_OACC_UPDATE: case ST_OACC_WAIT: case ST_OACC_CACHE: \
   case ST_OACC_ENTER_DATA: case ST_OACC_EXIT_DATA
 
@@ -1654,6 +1657,12 @@ gfc_ascii_statement (gfc_statement st)
     case ST_ELSEWHERE:
       p = "ELSEWHERE";
       break;
+    case ST_EVENT_POST:
+      p = "EVENT POST";
+      break;
+    case ST_EVENT_WAIT:
+      p = "EVENT WAIT";
+      break;
     case ST_END_ASSOCIATE:
       p = "END ASSOCIATE";
       break;
@@ -2646,7 +2655,7 @@ parse_derived (void)
   gfc_statement st;
   gfc_state_data s;
   gfc_symbol *sym;
-  gfc_component *c, *lock_comp = NULL;
+  gfc_component *c, *lock_comp = NULL, *event_comp = NULL;
 
   accept_statement (ST_DERIVED_DECL);
   push_state (&s, COMP_DERIVED, gfc_new_block);
@@ -2754,8 +2763,8 @@ endType:
   sym = gfc_current_block ();
   for (c = sym->components; c; c = c->next)
     {
-      bool coarray, lock_type, allocatable, pointer;
-      coarray = lock_type = allocatable = pointer = false;
+      bool coarray, lock_type, event_type, allocatable, pointer;
+      coarray = lock_type = event_type = allocatable = pointer = false;
 
       /* Look for allocatable components.  */
       if (c->attr.allocatable
@@ -2817,6 +2826,23 @@ endType:
 	  sym->attr.lock_comp = 1;
 	}
 
+      /* Looking for event_type components.  */
+      if ((c->ts.type == BT_DERIVED
+	      && c->ts.u.derived->from_intmod == INTMOD_ISO_FORTRAN_ENV
+	      && c->ts.u.derived->intmod_sym_id == ISOFORTRAN_EVENT_TYPE)
+	  || (c->ts.type == BT_CLASS && c->attr.class_ok
+	      && CLASS_DATA (c)->ts.u.derived->from_intmod
+		 == INTMOD_ISO_FORTRAN_ENV
+	      && CLASS_DATA (c)->ts.u.derived->intmod_sym_id
+		 == ISOFORTRAN_EVENT_TYPE)
+	  || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.event_comp
+	      && !allocatable && !pointer))
+	{
+	  event_type = 1;
+	  event_comp = c;
+	  sym->attr.event_comp = 1;
+	}
+
       /* Check for F2008, C1302 - and recall that pointers may not be coarrays
 	 (5.3.14) and that subobjects of coarray are coarray themselves (2.4.7),
 	 unless there are nondirect [allocatable or pointer] components
@@ -2857,6 +2883,43 @@ endType:
 		   "coarray subcomponent)", lock_comp->name, &lock_comp->loc,
 		   sym->name, c->name, &c->loc);
 
+      /* Similarly for EVENT TYPE.  */
+
+      if (pointer && !coarray && event_type)
+	gfc_error ("Component %s at %L of type EVENT_TYPE must have a "
+		   "codimension or be a subcomponent of a coarray, "
+		   "which is not possible as the component has the "
+		   "pointer attribute", c->name, &c->loc);
+      else if (pointer && !coarray && c->ts.type == BT_DERIVED
+	       && c->ts.u.derived->attr.event_comp)
+	gfc_error ("Pointer component %s at %L has a noncoarray subcomponent "
+		   "of type EVENT_TYPE, which must have a codimension or be a "
+		   "subcomponent of a coarray", c->name, &c->loc);
+
+      if (event_type && allocatable && !coarray)
+	gfc_error ("Allocatable component %s at %L of type EVENT_TYPE must have "
+		   "a codimension", c->name, &c->loc);
+      else if (event_type && allocatable && c->ts.type == BT_DERIVED
+	       && c->ts.u.derived->attr.event_comp)
+	gfc_error ("Allocatable component %s at %L must have a codimension as "
+		   "it has a noncoarray subcomponent of type EVENT_TYPE",
+		   c->name, &c->loc);
+
+      if (sym->attr.coarray_comp && !coarray && event_type)
+	gfc_error ("Noncoarray component %s at %L of type EVENT_TYPE or with "
+		   "subcomponent of type EVENT_TYPE must have a codimension or "
+		   "be a subcomponent of a coarray. (Variables of type %s may "
+		   "not have a codimension as already a coarray "
+		   "subcomponent exists)", c->name, &c->loc, sym->name);
+
+      if (sym->attr.event_comp && coarray && !event_type)
+	gfc_error ("Noncoarray component %s at %L of type EVENT_TYPE or with "
+		   "subcomponent of type EVENT_TYPE must have a codimension or "
+		   "be a subcomponent of a coarray. (Variables of type %s may "
+		   "not have a codimension as %s at %L has a codimension or a "
+		   "coarray subcomponent)", event_comp->name, &event_comp->loc,
+		   sym->name, c->name, &c->loc);
+
       /* Look for private components.  */
       if (sym->component_access == ACCESS_PRIVATE
 	  || c->attr.access == ACCESS_PRIVATE