[flang] Add check for constraints on synchronization-stmts

ktras · ktras · commit f770b1e95449 · 2022-10-25T10:30:28.000-07:00
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. Reviewed By: klausler Differential Revision: https://reviews.llvm.org/D136104
diff --git a/flang/lib/Semantics/check-coarray.cpp b/flang/lib/Semantics/check-coarray.cpp
@@ -82,13 +82,78 @@ static void CheckTeamStat(
   }
 }
 
+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) {
diff --git a/flang/lib/Semantics/check-coarray.h b/flang/lib/Semantics/check-coarray.h
@@ -19,6 +19,9 @@ struct ChangeTeamStmt;
 struct CoarrayAssociation;
 struct FormTeamStmt;
 struct ImageSelector;
+struct SyncAllStmt;
+struct SyncImagesStmt;
+struct SyncMemoryStmt;
 struct SyncTeamStmt;
 } // namespace Fortran::parser
 
@@ -28,6 +31,9 @@ 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 &);
diff --git a/flang/test/Semantics/synchronization01b.f90 b/flang/test/Semantics/synchronization01b.f90
@@ -22,16 +22,22 @@ program test_sync_all
   !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
diff --git a/flang/test/Semantics/synchronization02b.f90 b/flang/test/Semantics/synchronization02b.f90
@@ -20,7 +20,7 @@ program test_sync_images
   ! 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)
@@ -32,16 +32,22 @@ program test_sync_images
   !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
diff --git a/flang/test/Semantics/synchronization03b.f90 b/flang/test/Semantics/synchronization03b.f90
@@ -22,16 +22,22 @@ program test_sync_memory
   !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
diff --git a/flang/test/Semantics/synchronization04b.f90 b/flang/test/Semantics/synchronization04b.f90
@@ -27,16 +27,22 @@ program test_sync_team
   !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
