[flang] Semantic checking of LOCK statement (#129806)

Add checks for the LOCK statement, and complete and enable their tests.

Author: klausler

flang/lib/Semantics/check-coarray.cpp

@@ -7,6 +7,7 @@
 //===----------------------------------------------------------------------===//
 
 #include "check-coarray.h"
+#include "definable.h"
 #include "flang/Common/indirection.h"
 #include "flang/Evaluate/expression.h"
 #include "flang/Parser/message.h"
@@ -96,34 +97,37 @@ static void CheckCoindexedStatOrErrmsg(SemanticsContext &context,
   Fortran::common::visit(CoindexedCheck, statOrErrmsg.u);
 }
 
+static void CheckSyncStat(SemanticsContext &context,
+    const parser::StatOrErrmsg &statOrErrmsg, bool &gotStat, bool &gotMsg) {
+  common::visit(
+      common::visitors{
+          [&](const parser::StatVariable &stat) {
+            if (gotStat) {
+              context.Say( // C1172
+                  "The stat-variable in a sync-stat-list may not be repeated"_err_en_US);
+            }
+            gotStat = true;
+          },
+          [&](const parser::MsgVariable &var) {
+            WarnOnDeferredLengthCharacterScalar(context, GetExpr(context, var),
+                var.v.thing.thing.GetSource(), "ERRMSG=");
+            if (gotMsg) {
+              context.Say( // C1172
+                  "The errmsg-variable in a sync-stat-list may not be repeated"_err_en_US);
+            }
+            gotMsg = true;
+          },
+      },
+      statOrErrmsg.u);
+
+  CheckCoindexedStatOrErrmsg(context, statOrErrmsg, "sync-stat-list");
+}
+
 static void CheckSyncStatList(
     SemanticsContext &context, const std::list<parser::StatOrErrmsg> &list) {
   bool gotStat{false}, gotMsg{false};
-
   for (const parser::StatOrErrmsg &statOrErrmsg : list) {
-    common::visit(
-        common::visitors{
-            [&](const parser::StatVariable &stat) {
-              if (gotStat) {
-                context.Say( // C1172
-                    "The stat-variable in a sync-stat-list may not be repeated"_err_en_US);
-              }
-              gotStat = true;
-            },
-            [&](const parser::MsgVariable &var) {
-              WarnOnDeferredLengthCharacterScalar(context,
-                  GetExpr(context, var), var.v.thing.thing.GetSource(),
-                  "ERRMSG=");
-              if (gotMsg) {
-                context.Say( // C1172
-                    "The errmsg-variable in a sync-stat-list may not be repeated"_err_en_US);
-              }
-              gotMsg = true;
-            },
-        },
-        statOrErrmsg.u);
-
-    CheckCoindexedStatOrErrmsg(context, statOrErrmsg, "sync-stat-list");
+    CheckSyncStat(context, statOrErrmsg, gotStat, gotMsg);
   }
 }
 
@@ -260,7 +264,51 @@ void CoarrayChecker::Leave(const parser::EventWaitStmt &x) {
       context_, std::get<std::list<parser::EventWaitSpec>>(x.t));
 }
 
+static void CheckLockVariable(
+    SemanticsContext &context, const parser::LockVariable &lockVar) {
+  if (const SomeExpr * expr{GetExpr(lockVar)}) {
+    if (auto dyType{expr->GetType()}) {
+      auto at{parser::FindSourceLocation(lockVar)};
+      if (dyType->category() != TypeCategory::Derived ||
+          dyType->IsUnlimitedPolymorphic() ||
+          !IsLockType(&dyType->GetDerivedTypeSpec())) {
+        context.Say(at,
+            "Lock variable must have type LOCK_TYPE from ISO_FORTRAN_ENV"_err_en_US);
+      } else if (auto whyNot{WhyNotDefinable(at, context.FindScope(at),
+                     {DefinabilityFlag::DoNotNoteDefinition,
+                         DefinabilityFlag::AllowEventLockOrNotifyType},
+                     *expr)}) {
+        whyNot->set_severity(parser::Severity::Because);
+        context.Say(at, "Lock variable is not definable"_err_en_US)
+            .Attach(std::move(*whyNot));
+      }
+    }
+  }
+}
+
+void CoarrayChecker::Leave(const parser::LockStmt &x) {
+  CheckLockVariable(context_, std::get<parser::LockVariable>(x.t));
+  bool gotAcquired{false}, gotStat{false}, gotMsg{false};
+  for (const parser::LockStmt::LockStat &lockStat :
+      std::get<std::list<parser::LockStmt::LockStat>>(x.t)) {
+    if (const auto *statOrErrmsg{
+            std::get_if<parser::StatOrErrmsg>(&lockStat.u)}) {
+      CheckSyncStat(context_, *statOrErrmsg, gotStat, gotMsg);
+    } else {
+      CHECK(std::holds_alternative<
+          parser::Scalar<parser::Logical<parser::Variable>>>(lockStat.u));
+      if (gotAcquired) {
+        context_.Say(parser::FindSourceLocation(lockStat),
+            "Multiple ACQUIRED_LOCK specifiers"_err_en_US);
+      } else {
+        gotAcquired = true;
+      }
+    }
+  }
+}
+
 void CoarrayChecker::Leave(const parser::UnlockStmt &x) {
+  CheckLockVariable(context_, std::get<parser::LockVariable>(x.t));
   CheckSyncStatList(context_, std::get<std::list<parser::StatOrErrmsg>>(x.t));
 }
 

flang/lib/Semantics/check-coarray.h

@@ -28,6 +28,7 @@ struct SyncAllStmt;
 struct SyncImagesStmt;
 struct SyncMemoryStmt;
 struct SyncTeamStmt;
+struct LockStmt;
 struct UnlockStmt;
 } // namespace Fortran::parser
 
@@ -45,6 +46,7 @@ class CoarrayChecker : public virtual BaseChecker {
   void Leave(const parser::NotifyWaitStmt &);
   void Leave(const parser::EventPostStmt &);
   void Leave(const parser::EventWaitStmt &);
+  void Leave(const parser::LockStmt &);
   void Leave(const parser::UnlockStmt &);
   void Leave(const parser::CriticalStmt &);
   void Leave(const parser::ImageSelector &);

flang/test/Semantics/lockstmt03.f90

@@ -1,5 +1,4 @@
 ! RUN: %python %S/test_errors.py %s %flang_fc1
-! XFAIL: *
 ! This test checks for semantic errors in lock statements based on the
 ! statement specification in section 11.6.10 of the Fortran 2018 standard.
 
@@ -10,14 +9,16 @@ program test_lock_stmt
   character(len=128) error_message, msg_array(10), coindexed_msg[*], repeated_msg
   integer status, stat_array(10), coindexed_int[*], non_bool, repeated_stat
   logical non_integer, bool, bool_array(10), non_char, coindexed_logical[*], repeated_bool
-  type(lock_type) :: lock_var[*], lock_array(10)[*], non_coarray_lock
+  type(lock_type) :: lock_var[*], lock_array(10)[*]
+  !ERROR: Variable 'non_coarray_lock' with EVENT_TYPE or LOCK_TYPE must be a coarray
+  type(lock_type) :: non_coarray_lock
   type(event_type) :: not_lock_var[*]
 
   !___ non-standard-conforming statements ___
 
 ! type mismatches
 
-  !ERROR: to be determined
+  !ERROR: Lock variable must have type LOCK_TYPE from ISO_FORTRAN_ENV
   lock(not_lock_var)
 
   !ERROR: Must have LOGICAL type, but is INTEGER(4)
@@ -45,50 +46,65 @@ program test_lock_stmt
 
 ! corank mismatch
 
-  !ERROR: to be determined
-  lock(non_coarray_lock)
+  lock(non_coarray_lock) ! caught above
 
 ! C1173 - stat-variable and errmsg-variable shall not be a coindexed object
 
-  !ERROR: to be determined
+  !ERROR: The stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object
   lock(lock_var, stat=coindexed_int[1])
 
-  !ERROR: to be determined
+  !ERROR: The stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object
   lock(lock_var, errmsg=coindexed_msg[1])
 
-  !ERROR: to be determined
+  !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
   lock(lock_var, acquired_lock=coindexed_logical[1], stat=coindexed_int[1], errmsg=coindexed_msg[1])
 
 ! C1181 - No specifier shall appear more than once in a given lock-stat-list
 
-  !ERROR: to be determined
+  !ERROR: Multiple ACQUIRED_LOCK specifiers
   lock(lock_var, acquired_lock=bool, acquired_lock=repeated_bool)
 
-  !ERROR: to be determined
+  !ERROR: The stat-variable in a sync-stat-list may not be repeated
   lock(lock_var, stat=status, stat=repeated_stat)
 
-  !ERROR: to be determined
+  !ERROR: The errmsg-variable in a sync-stat-list may not be repeated
   lock(lock_var, errmsg=error_message, errmsg=repeated_msg)
 
-  !ERROR: to be determined
+  !ERROR: Multiple ACQUIRED_LOCK specifiers
   lock(lock_var, acquired_lock=bool, stat=status, errmsg=error_message, acquired_lock=repeated_bool)
 
-  !ERROR: to be determined
+  !ERROR: The stat-variable in a sync-stat-list may not be repeated
   lock(lock_var, acquired_lock=bool, stat=status, errmsg=error_message, stat=repeated_stat)
 
-  !ERROR: to be determined
+  !ERROR: The errmsg-variable in a sync-stat-list may not be repeated
   lock(lock_var, acquired_lock=bool, stat=status, errmsg=error_message, errmsg=repeated_msg)
 
-  !ERROR: to be determined
+  !ERROR: The stat-variable in a sync-stat-list may not be repeated
+  !ERROR: Multiple ACQUIRED_LOCK specifiers
   lock(lock_var, acquired_lock=bool, stat=status, errmsg=error_message, acquired_lock=repeated_bool, stat=repeated_stat)
 
-  !ERROR: to be determined
+  !ERROR: The errmsg-variable in a sync-stat-list may not be repeated
+  !ERROR: Multiple ACQUIRED_LOCK specifiers
   lock(lock_var, acquired_lock=bool, stat=status, errmsg=error_message, acquired_lock=repeated_bool, errmsg=repeated_msg)
 
-  !ERROR: to be determined
+  !ERROR: The stat-variable in a sync-stat-list may not be repeated
+  !ERROR: The errmsg-variable in a sync-stat-list may not be repeated
   lock(lock_var, acquired_lock=bool, stat=status, errmsg=error_message, stat=repeated_stat, errmsg=repeated_msg)
 
-  !ERROR: to be determined
+  !ERROR: The stat-variable in a sync-stat-list may not be repeated
+  !ERROR: The errmsg-variable in a sync-stat-list may not be repeated
+  !ERROR: Multiple ACQUIRED_LOCK specifiers
   lock(lock_var, acquired_lock=bool, stat=status, errmsg=error_message, acquired_lock=repeated_bool, stat=repeated_stat, errmsg=repeated_msg)
 
+ contains
+  subroutine lockit(x)
+    type(lock_type), intent(in) :: x[*]
+    !ERROR: Lock variable is not definable
+    !BECAUSE: 'x' is an INTENT(IN) dummy argument
+    lock(x)
+    !ERROR: Lock variable is not definable
+    !BECAUSE: 'x' is an INTENT(IN) dummy argument
+    unlock(x)
+  end
 end program test_lock_stmt