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, 82 insertions, 11 deletions

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index febf0fa..6598855 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -7055,6 +7055,21 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code, bool *array_alloc_wo_spec)
 		      &code->expr3->where, &e->where);
 	  goto failure;
 	}
+
+      /* Check TS18508, C702/C703.  */
+      if (code->expr3->ts.type == BT_DERIVED
+	  && ((codimension && gfc_expr_attr (code->expr3).event_comp)
+	      || (code->expr3->ts.u.derived->from_intmod
+		     == INTMOD_ISO_FORTRAN_ENV
+		  && code->expr3->ts.u.derived->intmod_sym_id
+		     == ISOFORTRAN_EVENT_TYPE)))
+	{
+	  gfc_error ("The source-expr at %L shall neither be of type "
+		     "EVENT_TYPE nor have a EVENT_TYPE component if "
+		      "allocate-object at %L is a coarray",
+		      &code->expr3->where, &e->where);
+	  goto failure;
+	}
     }
 
   /* Check F08:C629.  */
@@ -7106,6 +7121,13 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code, bool *array_alloc_wo_spec)
 	 no SOURCE exists by setting expr3.  */
       code->expr3 = gfc_default_initializer (&code->ext.alloc.ts);
     }
+  else if (flag_coarray != GFC_FCOARRAY_LIB && e->ts.type == BT_DERIVED
+	   && e->ts.u.derived->from_intmod == INTMOD_ISO_FORTRAN_ENV
+	   && e->ts.u.derived->intmod_sym_id == ISOFORTRAN_EVENT_TYPE)
+    {
+      /* We have to zero initialize the integer variable.  */
+      code->expr3 = gfc_get_int_expr (gfc_default_integer_kind, &e->where, 0);
+    }
   else if (!code->expr3)
     {
       /* Set up default initializer if needed.  */
@@ -8706,21 +8728,40 @@ find_reachable_labels (gfc_code *block)
 
 
 static void
-resolve_lock_unlock (gfc_code *code)
+resolve_lock_unlock_event (gfc_code *code)
 {
   if (code->expr1->expr_type == EXPR_FUNCTION
       && code->expr1->value.function.isym
       && code->expr1->value.function.isym->id == GFC_ISYM_CAF_GET)
     remove_caf_get_intrinsic (code->expr1);
 
-  if (code->expr1->ts.type != BT_DERIVED
-      || code->expr1->expr_type != EXPR_VARIABLE
-      || code->expr1->ts.u.derived->from_intmod != INTMOD_ISO_FORTRAN_ENV
-      || code->expr1->ts.u.derived->intmod_sym_id != ISOFORTRAN_LOCK_TYPE
-      || code->expr1->rank != 0
-      || (!gfc_is_coarray (code->expr1) && !gfc_is_coindexed (code->expr1)))
+  if ((code->op == EXEC_LOCK || code->op == EXEC_UNLOCK)
+      && (code->expr1->ts.type != BT_DERIVED
+	  || code->expr1->expr_type != EXPR_VARIABLE
+	  || code->expr1->ts.u.derived->from_intmod != INTMOD_ISO_FORTRAN_ENV
+	  || code->expr1->ts.u.derived->intmod_sym_id != ISOFORTRAN_LOCK_TYPE
+	  || code->expr1->rank != 0
+	  || (!gfc_is_coarray (code->expr1) &&
+	      !gfc_is_coindexed (code->expr1))))
     gfc_error ("Lock variable at %L must be a scalar of type LOCK_TYPE",
 	       &code->expr1->where);
+  else if ((code->op == EXEC_EVENT_POST && code->op == EXEC_EVENT_WAIT)
+	   && (code->expr1->ts.type != BT_DERIVED
+	       || code->expr1->expr_type != EXPR_VARIABLE
+	       || code->expr1->ts.u.derived->from_intmod
+		  != INTMOD_ISO_FORTRAN_ENV
+	       || code->expr1->ts.u.derived->intmod_sym_id
+		  != ISOFORTRAN_EVENT_TYPE
+	       || code->expr1->rank != 0))
+    gfc_error ("Event variable at %L must be a scalar of type EVENT_TYPE",
+	       &code->expr1->where);
+  else if (code->op == EXEC_EVENT_POST && !gfc_is_coarray (code->expr1)
+	   && !gfc_is_coindexed (code->expr1))
+    gfc_error ("Event variable argument at %L must be a coarray or coindexed",
+	       &code->expr1->where);
+  else if (code->op == EXEC_EVENT_WAIT && !gfc_is_coarray (code->expr1))
+    gfc_error ("Event variable argument at %L must be a coarray but not "
+	       "coindexed", &code->expr1->where);
 
   /* Check STAT.  */
   if (code->expr2
@@ -8746,17 +8787,23 @@ resolve_lock_unlock (gfc_code *code)
 				    _("ERRMSG variable")))
     return;
 
-  /* Check ACQUIRED_LOCK.  */
-  if (code->expr4
+  /* Check for LOCK the ACQUIRED_LOCK.  */
+  if (code->op != EXEC_EVENT_WAIT && code->expr4
       && (code->expr4->ts.type != BT_LOGICAL || code->expr4->rank != 0
 	  || code->expr4->expr_type != EXPR_VARIABLE))
     gfc_error ("ACQUIRED_LOCK= argument at %L must be a scalar LOGICAL "
 	       "variable", &code->expr4->where);
 
-  if (code->expr4
+  if (code->op != EXEC_EVENT_WAIT && code->expr4
       && !gfc_check_vardef_context (code->expr4, false, false, false,
 				    _("ACQUIRED_LOCK variable")))
     return;
+
+  /* Check for EVENT WAIT the UNTIL_COUNT.  */
+  if (code->op == EXEC_EVENT_WAIT && code->expr4
+      && (code->expr4->ts.type != BT_INTEGER || code->expr4->rank != 0))
+    gfc_error ("UNTIL_COUNT= argument at %L must be a scalar INTEGER "
+	       "expression", &code->expr4->where);
 }
 
 
@@ -10403,7 +10450,9 @@ start:
 
 	case EXEC_LOCK:
 	case EXEC_UNLOCK:
-	  resolve_lock_unlock (code);
+	case EXEC_EVENT_POST:
+	case EXEC_EVENT_WAIT:
+	  resolve_lock_unlock_event (code);
 	  break;
 
 	case EXEC_ENTRY:
@@ -14001,6 +14050,19 @@ resolve_symbol (gfc_symbol *sym)
       return;
     }
 
+  /* TS18508, C702/C703.  */
+  if (sym->ts.type == BT_DERIVED
+      && ((sym->ts.u.derived->from_intmod == INTMOD_ISO_FORTRAN_ENV
+	   && sym->ts.u.derived->intmod_sym_id == ISOFORTRAN_EVENT_TYPE)
+	  || sym->ts.u.derived->attr.event_comp)
+      && !sym->attr.codimension && !sym->ts.u.derived->attr.coarray_comp)
+    {
+      gfc_error ("Variable %s at %L of type EVENT_TYPE or with subcomponent of "
+		 "type LOCK_TYPE must be a coarray", sym->name,
+		 &sym->declared_at);
+      return;
+    }
+
   /* An assumed-size array with INTENT(OUT) shall not be of a type for which
      default initialization is defined (5.1.2.4.4).  */
   if (sym->ts.type == BT_DERIVED
@@ -14030,6 +14092,15 @@ resolve_symbol (gfc_symbol *sym)
       return;
     }
 
+  /* TS18508.  */
+  if (sym->ts.type == BT_DERIVED && sym->attr.dummy
+      && sym->attr.intent == INTENT_OUT && sym->attr.event_comp)
+    {
+      gfc_error ("Dummy argument %qs at %L of EVENT_TYPE shall not be "
+		 "INTENT(OUT)", sym->name, &sym->declared_at);
+      return;
+    }
+
   /* F2008, C525.  */
   if ((((sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.coarray_comp)
 	 || (sym->ts.type == BT_CLASS && sym->attr.class_ok