[flang] Add check for constraints on event-stmts

[ktras]

Summary

In the CoarrayChecker, add checks for the constraints C1177 and
C1178 for event-wait-stmt. Add event-post-stmt to the check
for the constraints for sync-stat-list. Add a check for the
constraint C1176 on event-variable.

[PeteSteinfeld]

Things generally look good, and everything builds and tests correctly. But if there's no problem moving the query functions to the Semantics directory, we should do that.

flang/include/flang/Evaluate/tools.h

1204–1205

Is Evaluate/tools.h the right place for these functions?

Note that the function IsOrContainsEventOrLockComponent() is in Semantics/tools.h. It also looks like all references to these functions come from within the Semantics directory. Putting them all in the same files and directory makes more sense to me.

[ktras]

flang/include/flang/Evaluate/tools.h

1204–1205

Thanks for the feedback. I put these new functions in Evaluate/tools.h since IsTeamType and IsEventTypeOrLockType are both there. I don't have a strong feeling where they should go, but if I move the new functions, then I think those other functions should probably also be moved. What do you think?

[PeteSteinfeld]

flang/include/flang/Evaluate/tools.h

1204–1205

Gee, IsTeamType is referenced in Evaluate/intrinsics.cpp, so it can't be moved even though it's logically related to the other functions. But IsEventTypeOrLockType is only referenced from the Semantics directory. For locality of reference, it make sense to me to move them.

[ktras]

flang/include/flang/Evaluate/tools.h

1204–1205

What you said about IsTeamType reminded me, I will need to call IsEventType from Evaluate/intrinsics.cpp as well when I add event_query to the list of intrinsic subroutines. I will not need to call IsLockType from that file. What would you think in that case? Still move IsEventType, IsLockType, and IsEventTypeOrLockType? Or just the last two that don't/won't have references in the Evaluate directory?

@klausler It looks like you originally wrote IsEventTypeOrLockType and IsTeamType, do you have an opinion on this?

[ktras]

Unfortunately, I let this patch sitting for a while, but I would like to push this soon. @PeteSteinfeld, thank you for the review and for the acceptance of the patch. Previously, I replied to your comment about moving IsEventType and IsLockType and stating that because of future planned changes to support event_query, it seems to me that these new functions should remain where they are now in this patch. Please let me know if you disagree, otherwise I plan to push this differential within the next couple days based on the revision having been accepted. Let me know if you would like me to hold off for further discussion, thanks.

[PeteSteinfeld]

In D137204#4342812, @ktras wrote:

Unfortunately, I let this patch sitting for a while, but I would like to push this soon. @PeteSteinfeld, thank you for the review and for the acceptance of the patch. Previously, I replied to your comment about moving IsEventType and IsLockType and stating that because of future planned changes to support event_query, it seems to me that these new functions should remain where they are now in this patch. Please let me know if you disagree, otherwise I plan to push this differential within the next couple days based on the revision having been accepted. Let me know if you would like me to hold off for further discussion, thanks.

Thanks, @ktras. It's OK with me to leave them where they are.

[ktras]

Thanks for the review, @PeteSteinfeld.

[PeteSteinfeld]

@ktras, this change is causing some of our internal tests to fail. Here's a small test case that illustrates the problem. This test should compile without error, but it gets a semantic error saying:

bug.f90:4:17: error: The event-variable must be a coarray
      event post (x[1])

Here's the source of the test:

subroutine bug
  use iso_fortran_env
  type(event_type), save :: x[*]
    event post (x[1])
end

[ktras]

@PeteSteinfeld, thanks for letting me know. You are right that the event-variable in an event-post-stmt is allowed to be a coindexed-object. It seems like the using the function evaluate::IsCoarray, as I did, to make sure that event-variable is a coarray disallows coindexed-objects. I will make some changes and open a new differential to address this.

[PeteSteinfeld]

In D137204#4350939, @ktras wrote:

@PeteSteinfeld, thanks for letting me know. You are right that the event-variable in an event-post-stmt is allowed to be a coindexed-object. It seems like the using the function evaluate::IsCoarray, as I did, to make sure that event-variable is a coarray disallows coindexed-objects. I will make some changes and open a new differential to address this.

Thanks, @ktras! You're the best.

flang/include/flang/Evaluate/tools.h

 bool IsAssumedShape(const Symbol &);
 bool IsDeferredShape(const Symbol &);
 bool IsFunctionResult(const Symbol &);
 bool IsKindTypeParameter(const Symbol &);
 bool IsLenTypeParameter(const Symbol &);
 bool IsExtensibleType(const DerivedTypeSpec *);
 bool IsBuiltinDerivedType(const DerivedTypeSpec *derived, const char *name);
 bool IsBuiltinCPtr(const Symbol &);
+bool IsEventType(const DerivedTypeSpec *);
+bool IsLockType(const DerivedTypeSpec *);
 // Is this derived type TEAM_TYPE from module ISO_FORTRAN_ENV?
 bool IsTeamType(const DerivedTypeSpec *);
 // Is this derived type TEAM_TYPE, C_PTR, or C_FUNPTR?
 bool IsBadCoarrayType(const DerivedTypeSpec *);
 // Is this derived type either C_PTR or C_FUNPTR from module ISO_C_BINDING
 bool IsIsoCType(const DerivedTypeSpec *);
 bool IsEventTypeOrLockType(const DerivedTypeSpec *);
 

flang/lib/Evaluate/tools.cpp

bool IsBuiltinCPtr(const Symbol &symbol) {
   return false;
 }
 
 bool IsIsoCType(const DerivedTypeSpec *derived) {
   return IsBuiltinDerivedType(derived, "c_ptr") ||
       IsBuiltinDerivedType(derived, "c_funptr");
 }
 
+bool IsEventType(const DerivedTypeSpec *derived) {
+  return IsBuiltinDerivedType(derived, "event_type");
+}
+
+bool IsLockType(const DerivedTypeSpec *derived) {
+  return IsBuiltinDerivedType(derived, "lock_type");
+}
+
 bool IsTeamType(const DerivedTypeSpec *derived) {
   return IsBuiltinDerivedType(derived, "team_type");
 }
 
 bool IsBadCoarrayType(const DerivedTypeSpec *derived) {
   return IsTeamType(derived) || IsIsoCType(derived);
 }
 
 bool IsEventTypeOrLockType(const DerivedTypeSpec *derivedTypeSpec) {
-  return IsBuiltinDerivedType(derivedTypeSpec, "event_type") ||
-      IsBuiltinDerivedType(derivedTypeSpec, "lock_type");
+  return IsEventType(derivedTypeSpec) || IsLockType(derivedTypeSpec);
 }
 
 int CountLenParameters(const DerivedTypeSpec &type) {
   return llvm::count_if(
       type.parameters(), [](const auto &pair) { return pair.second.isLen(); });
 }
 
 int CountNonConstantLenParameters(const DerivedTypeSpec &type) {

flang/lib/Semantics/check-coarray.h

 #include "flang/Semantics/semantics.h"
 #include <list>
 
 namespace Fortran::parser {
 class CharBlock;
 class MessageFixedText;
 struct ChangeTeamStmt;
 struct CoarrayAssociation;
+struct EventPostStmt;
+struct EventWaitStmt;
 struct FormTeamStmt;
 struct ImageSelector;
 struct SyncAllStmt;
 struct SyncImagesStmt;
 struct SyncMemoryStmt;
 struct SyncTeamStmt;
 } // namespace Fortran::parser
 
 namespace Fortran::semantics {
 
 class CoarrayChecker : public virtual BaseChecker {
 public:
   CoarrayChecker(SemanticsContext &context) : context_{context} {}
   void Leave(const parser::ChangeTeamStmt &);
   void Leave(const parser::SyncAllStmt &);
   void Leave(const parser::SyncImagesStmt &);
   void Leave(const parser::SyncMemoryStmt &);
   void Leave(const parser::SyncTeamStmt &);
+  void Leave(const parser::EventPostStmt &);
+  void Leave(const parser::EventWaitStmt &);
   void Leave(const parser::ImageSelector &);
   void Leave(const parser::FormTeamStmt &);
 
   void Enter(const parser::CriticalConstruct &);
 
 private:
   SemanticsContext &context_;
   bool haveStat_;

flang/lib/Semantics/check-coarray.cpp

common::visit(
             },
         },
         statOrErrmsg.u);
 
     CheckCoindexedStatOrErrmsg(context, statOrErrmsg, "sync-stat-list");
   }
 }
 
+static void CheckEventVariable(
+    SemanticsContext &context, const parser::EventVariable &eventVar) {
+  if (const auto *expr{GetExpr(context, eventVar)}) {
+    if (!IsEventType(evaluate::GetDerivedTypeSpec(expr->GetType()))) { // C1176
+      context.Say(parser::FindSourceLocation(eventVar),
+          "The event-variable must be of type EVENT_TYPE from module ISO_FORTRAN_ENV"_err_en_US);
+    } else if (!evaluate::IsCoarray(*expr)) { // C1604
+      context.Say(parser::FindSourceLocation(eventVar),
+          "The event-variable must be a coarray"_err_en_US);
+    }
+  }
+}
+
 void CoarrayChecker::Leave(const parser::ChangeTeamStmt &x) {
   CheckNamesAreDistinct(std::get<std::list<parser::CoarrayAssociation>>(x.t));
   CheckTeamType(context_, std::get<parser::TeamValue>(x.t));
 }
 
 void CoarrayChecker::Leave(const parser::SyncAllStmt &x) {
   CheckSyncStatList(context_, x.v);
 }
void CoarrayChecker::Leave(const parser::SyncMemoryStmt &x) {
   CheckSyncStatList(context_, x.v);
 }
 
 void CoarrayChecker::Leave(const parser::SyncTeamStmt &x) {
   CheckTeamType(context_, std::get<parser::TeamValue>(x.t));
   CheckSyncStatList(context_, std::get<std::list<parser::StatOrErrmsg>>(x.t));
 }
 
+void CoarrayChecker::Leave(const parser::EventPostStmt &x) {
+  CheckSyncStatList(context_, std::get<std::list<parser::StatOrErrmsg>>(x.t));
+  CheckEventVariable(context_, std::get<parser::EventVariable>(x.t));
+}
+
+void CoarrayChecker::Leave(const parser::EventWaitStmt &x) {
+  const auto &eventVar{std::get<parser::EventVariable>(x.t)};
+
+  if (const auto *expr{GetExpr(context_, eventVar)}) {
+    if (ExtractCoarrayRef(expr)) {
+      context_.Say(parser::FindSourceLocation(eventVar), // C1177
+          "A event-variable in a EVENT WAIT statement may not be a coindexed object"_err_en_US);
+    } else {
+      CheckEventVariable(context_, eventVar);
+    }
+  }
+
+  bool gotStat{false}, gotMsg{false}, gotUntil{false};
+  using EventWaitSpec = parser::EventWaitStmt::EventWaitSpec;
+  for (const EventWaitSpec &eventWaitSpec :
+      std::get<std::list<EventWaitSpec>>(x.t)) {
+    common::visit(
+        common::visitors{
+            [&](const parser::ScalarIntExpr &untilCount) {
+              if (gotUntil) {
+                context_.Say( // C1178
+                    "Until-spec in a event-wait-spec-list may not be repeated"_err_en_US);
+              }
+              gotUntil = true;
+            },
+            [&](const parser::StatOrErrmsg &statOrErrmsg) {
+              common::visit(
+                  common::visitors{
+                      [&](const parser::StatVariable &stat) {
+                        if (gotStat) {
+                          context_.Say( // C1178
+                              "A stat-variable in a event-wait-spec-list may not be repeated"_err_en_US);
+                        }
+                        gotStat = true;
+                      },
+                      [&](const parser::MsgVariable &errmsg) {
+                        if (gotMsg) {
+                          context_.Say( // C1178
+                              "A errmsg-variable in a event-wait-spec-list may not be repeated"_err_en_US);
+                        }
+                        gotMsg = true;
+                      },
+                  },
+                  statOrErrmsg.u);
+              CheckCoindexedStatOrErrmsg(
+                  context_, statOrErrmsg, "event-wait-spec-list");
+            },
+
+        },
+        eventWaitSpec.u);
+  }
+}
+
 void CoarrayChecker::Leave(const parser::ImageSelector &imageSelector) {
   haveStat_ = false;
   haveTeam_ = false;
   haveTeamNumber_ = false;
   for (const auto &imageSelectorSpec :
       std::get<std::list<parser::ImageSelectorSpec>>(imageSelector.t)) {
     if (const auto *team{
             std::get_if<parser::TeamValue>(&imageSelectorSpec.u)}) {

flang/test/Lower/pre-fir-tree04.f90

 ! RUN: %flang_fc1 -fdebug-pre-fir-tree %s | FileCheck %s
 
 ! Test Pre-FIR Tree captures all the coarray related statements
 
 ! CHECK: Subroutine test_coarray
 Subroutine test_coarray
   use iso_fortran_env, only: team_type, event_type, lock_type
   type(team_type) :: t
-  type(event_type) :: done
-  type(lock_type) :: alock
+  type(event_type) :: done[*]
+  type(lock_type) :: alock[*]
   real :: y[10,*]
   integer :: counter[*]
   logical :: is_square
   ! CHECK: <<ChangeTeamConstruct>>
   change team(t, x[5,*] => y)
     ! CHECK: AssignmentStmt
     x = x[4, 1]
   end team

flang/test/Semantics/critical02.f90

critical
     critical
     !ERROR: An image control statement is not allowed in a CRITICAL construct
     end critical
   end critical
 end subroutine test6
 
 subroutine test7()
   use iso_fortran_env
-  type(event_type) :: x, y
+  type(event_type) :: x[*], y[*]
   critical
     !ERROR: An image control statement is not allowed in a CRITICAL construct
     event post (x)
     !ERROR: An image control statement is not allowed in a CRITICAL construct
     event wait (y)
   end critical
 end subroutine test7
 

flang/test/Semantics/doconcurrent01.f90

 ! The following is OK
   do concurrent (i = 1:n)
         call ieee_set_flag(flag, flagValue)
   end do
 end subroutine do_concurrent_test2
 
 subroutine s1()
   use iso_fortran_env
-  type(event_type) :: x
+  type(event_type) :: x[*]
   do concurrent (i = 1:n)
 !ERROR: An image control statement is not allowed in DO CONCURRENT
     event post (x)
   end do
 end subroutine s1
 
 subroutine s2()
   use iso_fortran_env
-  type(event_type) :: x
+  type(event_type) :: x[*]
   do concurrent (i = 1:n)
 !ERROR: An image control statement is not allowed in DO CONCURRENT
     event wait (x)
   end do
 end subroutine s2
 
 subroutine s3()
   use iso_fortran_env

flang/test/Semantics/event01b.f90

program test_event_post
   character(len=128) error_message, co_indexed_character[*], superfluous_errmsg
   logical invalid_type
 
   !___ non-standard-conforming statements ___
 
   !______ invalid event-variable ____________________________
 
   ! event-variable must be event_type
+  !ERROR: The event-variable must be of type EVENT_TYPE from module ISO_FORTRAN_ENV
   event post(non_event)
 
   ! event-variable must be a coarray
+  !ERROR: The event-variable must be a coarray
   event post(non_coarray)
 
   !ERROR: Must be a scalar value, but is a rank-1 array
   event post(occurrences)
 
   !ERROR: Must be a scalar value, but is a rank-1 array
   event post(occurrences[1])
 
   !______ invalid sync-stat-lists: invalid stat= ____________
 
   !ERROR: Must have INTEGER type, but is LOGICAL(4)
   event post(concert, stat=invalid_type)
 
   !ERROR: Must be a scalar value, but is a rank-1 array
   event post(concert, stat=non_scalar)
 
   !______ invalid sync-stat-lists: invalid errmsg= ____________
 
   !ERROR: Must have CHARACTER type, but is LOGICAL(4)
   event post(concert, errmsg=invalid_type)
 
   !______ invalid sync-stat-lists: redundant sync-stat-list ____________
 
-  ! No specifier shall appear more than once in a given sync-stat-list
+  !ERROR: The stat-variable in a sync-stat-list may not be repeated
   event post(concert, stat=sync_status, stat=superfluous_stat)
 
-  ! No specifier shall appear more than once in a given sync-stat-list
+  !ERROR: The stat-variable in a sync-stat-list may not be repeated
+  event post(concert, errmsg=error_message, stat=sync_status, stat=superfluous_stat)
+
+  !ERROR: The stat-variable in a sync-stat-list may not be repeated
+  event post(concert, stat=sync_status, errmsg=error_message, stat=superfluous_stat)
+
+  !ERROR: The stat-variable in a sync-stat-list may not be repeated
+  event post(concert, stat=sync_status, stat=superfluous_stat, errmsg=error_message)
+
+  !ERROR: The errmsg-variable in a sync-stat-list may not be repeated
   event post(concert, errmsg=error_message, errmsg=superfluous_errmsg)
 
-  !______ invalid sync-stat-lists: coindexed stat-variable ____________
+  !ERROR: The errmsg-variable in a sync-stat-list may not be repeated
+  event post(concert, stat=sync_status, errmsg=error_message, errmsg=superfluous_errmsg)
+
+  !ERROR: The errmsg-variable in a sync-stat-list may not be repeated
+  event post(concert, errmsg=error_message, stat=sync_status, errmsg=superfluous_errmsg)
+
+  !ERROR: The errmsg-variable in a sync-stat-list may not be repeated
+  event post(concert, errmsg=error_message, errmsg=superfluous_errmsg, stat=sync_status)
 
-  ! Check constraint C1173 from the Fortran 2018 standard
+  !______ invalid sync-stat-lists: coindexed stat-variable - C1173____________
+
+  !ERROR: The stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object
   event post(concert, stat=co_indexed_integer[1])
 
-  ! Check constraint C1173 from the Fortran 2018 standard
+  !ERROR: The stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object
   event post(concert, errmsg=co_indexed_character[1])
 
+  !ERROR: The stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object
+  event post(concert, stat=co_indexed_integer[1], errmsg=error_message)
+
+  !ERROR: The stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object
+  event post(concert, stat=sync_status, errmsg=co_indexed_character[1])
+
+  !ERROR: The stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object
+  !ERROR: The stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object
+  event post(concert, stat=co_indexed_integer[1], errmsg=co_indexed_character[1])
+
+  !ERROR: The stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object
+  !ERROR: The stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object
+  event post(concert, errmsg=co_indexed_character[1], stat=co_indexed_integer[1])
+
 end program test_event_post

flang/test/Semantics/event02b.f90

program test_event_wait
   integer threshold, indexed(1), non_event[*], sync_status, co_indexed_integer[*], superfluous_stat, non_scalar(1)
   character(len=128) error_message, non_scalar_char(1), co_indexed_character[*], superfluous_errmsg
   logical invalid_type
 
   !____________________ non-standard-conforming statements __________________________
 
   !_________________________ invalid event-variable ________________________________
 
-  ! event-variable must be event_type
+  !ERROR: The event-variable must be of type EVENT_TYPE from module ISO_FORTRAN_ENV
   event wait(non_event)
 
-  ! event-variable must be a coarray
+  !ERROR: The event-variable must be a coarray
   event wait(non_coarray)
 
-  ! event-variable must not be coindexed
+  !ERROR: A event-variable in a EVENT WAIT statement may not be a coindexed object
   event wait(concert[1])
 
-  ! event-variable must not be coindexed
+  !ERROR: A event-variable in a EVENT WAIT statement may not be a coindexed object
   event wait(occurrences(1)[1])
 
   !ERROR: Must be a scalar value, but is a rank-1 array
   event wait(occurrences)
 
   !_____________ invalid event-wait-spec-lists: invalid until-spec _________________
 
   !ERROR: Must have INTEGER type, but is LOGICAL(4)
program test_event_wait
   !ERROR: Must have CHARACTER type, but is LOGICAL(4)
   event wait(concert, errmsg=invalid_type)
 
   !ERROR: Must be a scalar value, but is a rank-1 array
   event wait(concert, errmsg=non_scalar_char)
 
   !______ invalid event-wait-spec-lists: redundant event-wait-spec-list ____________
 
-  ! No specifier shall appear more than once in a given event-wait-spec-list
+  !ERROR: Until-spec in a event-wait-spec-list may not be repeated
   event wait(concert, until_count=threshold, until_count=indexed(1))
 
-  ! No specifier shall appear more than once in a given event-wait-spec-list
+  !ERROR: Until-spec in a event-wait-spec-list may not be repeated
+  event wait(concert, until_count=threshold, stat=sync_status, until_count=indexed(1))
+
+  !ERROR: Until-spec in a event-wait-spec-list may not be repeated
+  event wait(concert, until_count=threshold, errmsg=error_message, until_count=indexed(1))
+
+  !ERROR: Until-spec in a event-wait-spec-list may not be repeated
+  event wait(concert, until_count=threshold, stat=sync_status, errmsg=error_message, until_count=indexed(1))
+
+  !ERROR: A stat-variable in a event-wait-spec-list may not be repeated
   event wait(concert, stat=sync_status, stat=superfluous_stat)
 
-  ! No specifier shall appear more than once in a given event-wait-spec-list
+  !ERROR: A stat-variable in a event-wait-spec-list may not be repeated
+  event wait(concert, stat=sync_status, until_count=threshold, stat=superfluous_stat)
+
+  !ERROR: A stat-variable in a event-wait-spec-list may not be repeated
+  event wait(concert, stat=sync_status, errmsg=error_message, stat=superfluous_stat)
+
+  !ERROR: A stat-variable in a event-wait-spec-list may not be repeated
+  event wait(concert, stat=sync_status, until_count=threshold, errmsg=error_message, stat=superfluous_stat)
+
+  !ERROR: A errmsg-variable in a event-wait-spec-list may not be repeated
   event wait(concert, errmsg=error_message, errmsg=superfluous_errmsg)
 
-  !_____________ invalid sync-stat-lists: coindexed stat-variable __________________
+  !ERROR: A errmsg-variable in a event-wait-spec-list may not be repeated
+  event wait(concert, errmsg=error_message, until_count=threshold, errmsg=superfluous_errmsg)
 
-  ! Check constraint C1173 from the Fortran 2018 standard
+  !ERROR: A errmsg-variable in a event-wait-spec-list may not be repeated
+  event wait(concert, errmsg=error_message, stat=superfluous_stat, errmsg=superfluous_errmsg)
+
+  !ERROR: A errmsg-variable in a event-wait-spec-list may not be repeated
+  event wait(concert, errmsg=error_message, until_count=threshold, stat=superfluous_stat, errmsg=superfluous_errmsg)
+
+  !_____________ invalid sync-stat-lists: coindexed stat-variable - C1173 __________________
+
+  !ERROR: The stat-variable or errmsg-variable in a event-wait-spec-list may not be a coindexed object
   event wait(concert, stat=co_indexed_integer[1])
 
-  ! Check constraint C1173 from the Fortran 2018 standard
+  !ERROR: The stat-variable or errmsg-variable in a event-wait-spec-list may not be a coindexed object
   event wait(concert, errmsg=co_indexed_character[1])
 
+  !ERROR: The stat-variable or errmsg-variable in a event-wait-spec-list may not be a coindexed object
+  event wait(concert, stat=co_indexed_integer[1], errmsg=error_message)
+
+  !ERROR: The stat-variable or errmsg-variable in a event-wait-spec-list may not be a coindexed object
+  event wait(concert, stat=sync_status, errmsg=co_indexed_character[1])
+
+  !ERROR: The stat-variable or errmsg-variable in a event-wait-spec-list may not be a coindexed object
+  !ERROR: The stat-variable or errmsg-variable in a event-wait-spec-list may not be a coindexed object
+  event wait(concert, stat=co_indexed_integer[1], errmsg=co_indexed_character[1])
+
+  !ERROR: The stat-variable or errmsg-variable in a event-wait-spec-list may not be a coindexed object
+  !ERROR: The stat-variable or errmsg-variable in a event-wait-spec-list may not be a coindexed object
+  event wait(concert, errmsg=co_indexed_character[1], stat=co_indexed_integer[1])
+
 end program test_event_wait