[flang] Add check for constraints on synchronization-stmts

[ktras]

Summary

In the CoarrayChecker, add checks for the constraints C1172 and
C1173, which constrain sync-stat-list. Add these checks to
sync-all-stmt, sync-images-stmt, sync-memory-stmt, and
sync-team-stmt. Also add a check for the constraint C1174 in
sync-images-stmt. Update semantics tests for these stmts.

The CheckCoindexedStatOrErrmsg function is a separate function from the
singular function that it is currently called from, because there are future changes planned
which will also need to call this function.

[klausler]

flang/lib/Semantics/check-coarray.cpp

85

Is there a numbered constraint in the standard that should appear in a comment here?

87

braced initialization please

[ktras]

Make changes based on reviewer feedback: Add comments with numbered constraints and change an assignment statement to braced initialization.

[ktras]

Move comment location.

[ktras]

flang/lib/Semantics/check-coarray.cpp

85

I have updated the patch and added comments with the numbered constraints.

[ktras]

Ping.

flang/lib/Semantics/check-coarray.h

 
 namespace Fortran::parser {
 class CharBlock;
 class MessageFixedText;
 struct ChangeTeamStmt;
 struct CoarrayAssociation;
 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::ImageSelector &);
   void Leave(const parser::FormTeamStmt &);
 
   void Enter(const parser::CriticalConstruct &);
 
 private:
   SemanticsContext &context_;

flang/lib/Semantics/check-coarray.cpp

static void CheckTeamStat(
   const parser::Variable &var{stat.v.thing.thing.value()};
   if (parser::GetCoindexedNamedObject(var)) {
     context.Say(parser::FindSourceLocation(var), // C931
         "Image selector STAT variable must not be a coindexed "
         "object"_err_en_US);
   }
 }
 
+static void CheckCoindexedStatOrErrmsg(SemanticsContext &context,
+    const parser::StatOrErrmsg &statOrErrmsg, const std::string &listName) {
+  auto CoindexedCheck{[&](const auto &statOrErrmsg) {
+    if (const auto *expr{GetExpr(context, statOrErrmsg)}) {
+      if (ExtractCoarrayRef(expr)) {
+        context.Say(parser::FindSourceLocation(statOrErrmsg), // C1173
+            "The stat-variable or errmsg-variable in a %s may not be a coindexed object"_err_en_US,
+            listName);
+      }
+    }
+  }};
+  std::visit(CoindexedCheck, statOrErrmsg.u);
+}
+
+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 &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");
+  }
+}
+
 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::SyncImagesStmt &x) {
+  CheckSyncStatList(context_, std::get<std::list<parser::StatOrErrmsg>>(x.t));
+
+  const auto &imageSet{std::get<parser::SyncImagesStmt::ImageSet>(x.t)};
+  if (const auto *intExpr{std::get_if<parser::IntExpr>(&imageSet.u)}) {
+    if (const auto *expr{GetExpr(context_, *intExpr)}) {
+      if (expr->Rank() > 1) {
+        context_.Say(parser::FindSourceLocation(imageSet), // C1174
+            "An image-set that is an int-expr must be a scalar or a rank-one array"_err_en_US);
+      }
+    }
+  }
+}
+
+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::ImageSelector &imageSelector) {
   haveStat_ = false;
   haveTeam_ = false;
   haveTeamNumber_ = false;
   for (const auto &imageSelectorSpec :
       std::get<std::list<parser::ImageSelectorSpec>>(imageSelector.t)) {

flang/test/Semantics/synchronization01b.f90

program test_sync_all
   sync all(stat=invalid_type)
 
   !ERROR: Must be a scalar value, but is a rank-1 array
   sync all(stat=non_scalar)
 
   !ERROR: Must have CHARACTER type, but is LOGICAL(4)
   sync all(errmsg=invalid_type)
 
-  ! 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
   sync all(stat=sync_status, stat=superfluous_stat)
 
-  ! No specifier shall appear more than once in a given sync-stat-list
+  !ERROR: The errmsg-variable in a sync-stat-list may not be repeated
   sync all(errmsg=error_message, errmsg=superfluous_errmsg)
 
-  ! Fortran 2018 standard C1173: `stat` shall not be coindexed
+  !ERROR: The stat-variable in a sync-stat-list may not be repeated
+  sync all(stat=sync_status, errmsg=error_message, stat=superfluous_stat)
+
+  !ERROR: The errmsg-variable in a sync-stat-list may not be repeated
+  sync all(stat=sync_status, errmsg=error_message, errmsg=superfluous_errmsg)
+
+  !ERROR: The stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object
   sync all(stat=co_indexed_integer[1])
 
-  ! Fortran 2018 standard C1173: `errmsg` shall not be coindexed
+  !ERROR: The stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object
   sync all(errmsg=co_indexed_character[1])
 
 end program test_sync_all

flang/test/Semantics/synchronization02b.f90

program test_sync_images
   !___ non-standard-conforming statements ___
 
   ! Image set shall not depend on the value of stat-variable
   sync images(sync_status, stat=sync_status)
 
   ! Image set shall not depend on the value of errmsg-variable
   sync images(len(error_message), errmsg=error_message)
 
-  ! Image set shall be a scalar or rank-1 array
+  !ERROR: An image-set that is an int-expr must be a scalar or a rank-one array
   sync images(invalid_rank)
 
   !ERROR: Must have INTEGER type, but is LOGICAL(4)
   sync images([1], stat=invalid_type)
 
   !ERROR: Must be a scalar value, but is a rank-1 array
   sync images(*, stat=non_scalar)
 
   !ERROR: Must have CHARACTER type, but is LOGICAL(4)
   sync images(1, errmsg=invalid_type)
 
-  ! 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
   sync images(1, 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
+  sync images(1, stat=sync_status, errmsg=error_message, stat=superfluous_stat)
+
+  !ERROR: The errmsg-variable in a sync-stat-list may not be repeated
   sync images([1], errmsg=error_message, errmsg=superfluous_errmsg)
 
-  ! Fortran 2018 standard C1173: `stat` shall not be coindexed
+  !ERROR: The errmsg-variable in a sync-stat-list may not be repeated
+  sync images([1], stat=sync_status, errmsg=error_message, errmsg=superfluous_errmsg)
+
+  !ERROR: The stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object
   sync images(*, stat=coindexed_integer[1])
 
-  ! Fortran 2018 standard C1173: `errmsg` shall not be coindexed
+  !ERROR: The stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object
   sync images(1, errmsg=coindexed_character[1])
 
 end program test_sync_images

flang/test/Semantics/synchronization03b.f90

program test_sync_memory
   sync memory(stat=invalid_type)
 
   !ERROR: Must be a scalar value, but is a rank-1 array
   sync memory(stat=non_scalar)
 
   !ERROR: Must have CHARACTER type, but is LOGICAL(4)
   sync memory(errmsg=invalid_type)
 
-  ! 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
   sync memory(stat=sync_status, stat=superfluous_stat)
 
-  ! No specifier shall appear more than once in a given sync-stat-list
+  !ERROR: The errmsg-variable in a sync-stat-list may not be repeated
   sync memory(errmsg=error_message, errmsg=superfluous_errmsg)
 
-  ! Fortran 2018 standard C1173: `stat` shall not be coindexed
+  !ERROR: The stat-variable in a sync-stat-list may not be repeated
+  sync memory(stat=sync_status, errmsg=error_message, stat=superfluous_stat)
+
+  !ERROR: The errmsg-variable in a sync-stat-list may not be repeated
+  sync memory(stat=sync_status, errmsg=error_message, errmsg=superfluous_errmsg)
+
+  !ERROR: The stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object
   sync memory(stat=co_indexed_integer[1])
 
-  ! Fortran 2018 standard C1173: `errmsg` shall not be coindexed
+  !ERROR: The stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object
   sync memory(errmsg=co_indexed_character[1])
 
 end program test_sync_memory

flang/test/Semantics/synchronization04b.f90

program test_sync_team
   sync team(warriors, stat=invalid_type)
 
   !ERROR: Must be a scalar value, but is a rank-1 array
   sync team(warriors, stat=non_scalar)
 
   !ERROR: Must have CHARACTER type, but is LOGICAL(4)
   sync team(warriors, errmsg=invalid_type)
 
-  ! 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
   sync team(warriors, stat=sync_status, stat=superfluous_stat)
 
-  ! No specifier shall appear more than once in a given sync-stat-list
+  !ERROR: The errmsg-variable in a sync-stat-list may not be repeated
   sync team(warriors, errmsg=error_message, errmsg=superfluous_errmsg)
 
-  ! Fortran 2018 standard C1173: `stat` shall not be coindexed
+  !ERROR: The stat-variable in a sync-stat-list may not be repeated
+  sync team(warriors, stat=sync_status, errmsg=error_message, stat=superfluous_stat)
+
+  !ERROR: The errmsg-variable in a sync-stat-list may not be repeated
+  sync team(warriors, stat=sync_status, errmsg=error_message, errmsg=superfluous_errmsg)
+
+  !ERROR: The stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object
   sync team(warriors, stat=co_indexed_integer[1])
 
-  ! Fortran 2018 standard C1173: `errmsg` shall not be coindexed
+  !ERROR: The stat-variable or errmsg-variable in a sync-stat-list may not be a coindexed object
   sync team(warriors, errmsg=co_indexed_character[1])
 
 end program test_sync_team