[flang] Added semantic checks for map clauses

Original-commit: flang-compiler/f18@75b6228388
Reviewed-on: https://github.com/flang-compiler/f18/pull/748
Tree-same-pre-rewrite: false

flang/lib/semantics/check-omp-structure.cc

@@ -130,6 +130,15 @@ void OmpStructureChecker::CheckAllowed(OmpClause type) {
   SetContextClauseInfo(type);
 }
 
+void OmpStructureChecker::CheckRequired(OmpClause c) {
+  auto *clause{FindClause(c)};
+  if (!clause) {
+    context_.Say(GetContext().directiveSource,
+        "At least one %s clause must appear on the %s directive"_err_en_US,
+        EnumToString(c), ContextDirectiveAsFortran());
+  }
+}
+
 void OmpStructureChecker::RequiresConstantPositiveParameter(
     const OmpClause &clause, const parser::ScalarIntConstantExpr &i) {
   if (const auto v{GetIntValue(i)}) {
@@ -419,6 +428,19 @@ void OmpStructureChecker::Enter(const parser::OpenMPBlockConstruct &x) {
     OmpClauseSet allowedOnce{
         OmpClause::NUM_TEAMS, OmpClause::THREAD_LIMIT, OmpClause::DEFAULT};
     SetContextAllowedOnce(allowedOnce);
+  } break;
+      // 2.10.1 target-data-clause -> if-clause |
+      //                              device-clause |
+      //                              map-clause |
+      //                              use-device-ptr-clause
+  case parser::OmpBlockDirective::Directive::TargetData: {
+    PushContext(beginDir.source, OmpDirective::TARGET_DATA);
+    OmpClauseSet allowed{
+        OmpClause::IF, OmpClause::MAP, OmpClause::USE_DEVICE_PTR};
+    SetContextAllowed(allowed);
+    OmpClauseSet allowedOnce{OmpClause::DEVICE};
+    SetContextAllowedOnce(allowedOnce);
+    SetContextRequired(OmpClauseSet{OmpClause::MAP});
   } break;
   default:
     // TODO others
@@ -532,10 +554,20 @@ void OmpStructureChecker::Enter(
   case parser::OmpSimpleStandaloneDirective::Directive::TargetEnterData: {
     // 2.10.2 target-enter-data
     PushContext(dir.source, OmpDirective::TARGET_ENTER_DATA);
+    OmpClauseSet allowed{OmpClause::MAP, OmpClause::DEPEND, OmpClause::NOWAIT};
+    SetContextAllowed(allowed);
+    OmpClauseSet allowedOnce{OmpClause::DEVICE, OmpClause::IF};
+    SetContextAllowedOnce(allowedOnce);
+    SetContextRequired(OmpClauseSet{OmpClause::MAP});
   } break;
   case parser::OmpSimpleStandaloneDirective::Directive::TargetExitData: {
     // 2.10.3 target-exit-data
     PushContext(dir.source, OmpDirective::TARGET_EXIT_DATA);
+    OmpClauseSet allowed{OmpClause::MAP, OmpClause::DEPEND, OmpClause::NOWAIT};
+    SetContextAllowed(allowed);
+    OmpClauseSet allowedOnce{OmpClause::DEVICE, OmpClause::IF};
+    SetContextAllowedOnce(allowedOnce);
+    SetContextRequired(OmpClauseSet{OmpClause::MAP});
   } break;
   case parser::OmpSimpleStandaloneDirective::Directive::TargetUpdate: {
     // 2.10.5 target-update
@@ -899,8 +931,41 @@ void OmpStructureChecker::Enter(const parser::OmpLinearClause &x) {
     }
   }
 }
-void OmpStructureChecker::Enter(const parser::OmpMapClause &) {
+void OmpStructureChecker::Enter(const parser::OmpMapClause &x) {
   CheckAllowed(OmpClause::MAP);
+  if (const auto &maptype{std::get<std::optional<parser::OmpMapType>>(x.t)}) {
+    using Type = parser::OmpMapType::Type;
+    const Type &type = std::get<Type>(maptype->t);
+    switch (GetContext().directive) {
+    case OmpDirective::TARGET:
+    case OmpDirective::TARGET_DATA: {
+      if (type != Type::To && type != Type::From && type != Type::Tofrom &&
+          type != Type::Alloc) {
+        context_.Say(GetContext().clauseSource,
+            "Only the to, from, tofrom or alloc map types are permitted "
+            "for MAP clauses on the %s directive"_err_en_US,
+            ContextDirectiveAsFortran());
+      }
+    } break;
+    case OmpDirective::TARGET_ENTER_DATA: {
+      if (type != Type::To && type != Type::Alloc) {
+        context_.Say(GetContext().clauseSource,
+            "Only the to or alloc map types are permitted "
+            "for MAP clauses on the %s directive"_err_en_US,
+            ContextDirectiveAsFortran());
+      }
+    } break;
+    case OmpDirective::TARGET_EXIT_DATA: {
+      if (type != Type::Delete && type != Type::Release && type != Type::From) {
+        context_.Say(GetContext().clauseSource,
+            "Only the from, release or delete map types are permitted "
+            "for MAP clauses on the %s directive"_err_en_US,
+            ContextDirectiveAsFortran());
+      }
+    } break;
+    default: break;
+    }
+  }
 }
 void OmpStructureChecker::Enter(const parser::OmpProcBindClause &) {
   CheckAllowed(OmpClause::PROC_BIND);

flang/lib/semantics/check-omp-structure.h

@@ -138,6 +138,7 @@ private:
     OmpClauseSet allowedClauses{};
     OmpClauseSet allowedOnceClauses{};
     OmpClauseSet allowedExclusiveClauses{};
+    OmpClauseSet requiredClauses{};
 
     const parser::OmpClause *clause{nullptr};
     std::multimap<OmpClause, const parser::OmpClause *> clauseInfo;
@@ -151,10 +152,13 @@ private:
   // collected information for END directive
   void ResetPartialContext(const parser::CharBlock &source) {
     CHECK(!ompContext_.empty());
+    GetContext().requiredClauses.IterateOverMembers(
+        [this](OmpClause c) { CheckRequired(c); });
     SetContextDirectiveSource(source);
     GetContext().allowedClauses = {};
     GetContext().allowedOnceClauses = {};
     GetContext().allowedExclusiveClauses = {};
+    GetContext().requiredClauses = {};
     GetContext().clauseInfo = {};
   }
   void SetContextDirectiveSource(const parser::CharBlock &directive) {
@@ -176,6 +180,9 @@ private:
   void SetContextAllowedExclusive(const OmpClauseSet &allowedExclusive) {
     GetContext().allowedExclusiveClauses = allowedExclusive;
   }
+  void SetContextRequired(const OmpClauseSet &required) {
+    GetContext().requiredClauses = required;
+  }
   void SetContextClauseInfo(OmpClause type) {
     GetContext().clauseInfo.emplace(type, GetContext().clause);
   }
@@ -199,6 +206,7 @@ private:
   bool HasInvalidWorksharingNesting(
       const parser::CharBlock &, const OmpDirectiveSet &);
   void CheckAllowed(OmpClause);
+  void CheckRequired(OmpClause);
   std::string ContextDirectiveAsFortran();
   void SayNotMatching(const parser::CharBlock &, const parser::CharBlock &);
   template<typename A, typename B, typename C>

flang/test/semantics/omp-device-constructs.f90

@@ -111,4 +111,43 @@ program main
   enddo
   !$omp end teams
 
+  !$omp target map(tofrom:a)
+  do i = 1, N
+     a = 3.14
+  enddo
+  !$omp end target
+
+  !ERROR: Only the to, from, tofrom or alloc map types are permitted for MAP clauses on the TARGET directive
+  !$omp target map(delete:a)
+  do i = 1, N
+     a = 3.14
+  enddo
+  !$omp end target
+
+  !$omp target data device(0) map(to:a)
+  do i = 1, N
+    a = 3.14
+  enddo
+  !$omp end target data
+
+  !ERROR: At least one MAP clause must appear on the TARGET DATA directive
+  !$omp target data device(0)
+  do i = 1, N
+     a = 3.14
+  enddo
+  !$omp end target data
+
+  !ERROR: At most one IF clause can appear on the TARGET ENTER DATA directive
+  !$omp target enter data map(to:a) if(.true.) if(.false.)
+
+  !ERROR: Only the to or alloc map types are permitted for MAP clauses on the TARGET ENTER DATA directive
+  !$omp target enter data map(from:a)
+
+  !$omp target exit data map(delete:a)
+
+  !ERROR: At most one DEVICE clause can appear on the TARGET EXIT DATA directive
+  !$omp target exit data map(from:a) device(0) device(1)
+
+  !ERROR: Only the from, release or delete map types are permitted for MAP clauses on the TARGET EXIT DATA directive
+  !$omp target exit data map(to:a)
 end program main