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,