[flang][OpenMP] Issue a warning when parsing future directive spelling

OpenMP 6.0 introduced alternative spelling for some directives, with the
previous spellings still allowed.

Warn the user when a new spelling is encountered with OpenMP version set
to an older value.

Author: kparzysz

flang/include/flang/Parser/parse-tree.h

@@ -4612,7 +4612,7 @@ struct OmpDirectiveSpecification {
 
 struct OmpMetadirectiveDirective {
   TUPLE_CLASS_BOILERPLATE(OmpMetadirectiveDirective);
-  std::tuple<OmpClauseList> t;
+  std::tuple<Verbatim, OmpClauseList> t;
   CharBlock source;
 };
 

flang/lib/Parser/openmp-parsers.cpp

@@ -1194,7 +1194,7 @@ TYPE_PARSER(sourced(construct<OpenMPUtilityConstruct>(
         sourced(Parser<OmpNothingDirective>{}))))))
 
 TYPE_PARSER(sourced(construct<OmpMetadirectiveDirective>(
-    "METADIRECTIVE" >> Parser<OmpClauseList>{})))
+    verbatim("METADIRECTIVE"_tok), Parser<OmpClauseList>{})))
 
 // Omp directives enclosing do loop
 TYPE_PARSER(sourced(construct<OmpLoopDirective>(first(
@@ -1687,7 +1687,7 @@ TYPE_PARSER(sourced(construct<OmpAssumeDirective>(
     verbatim("ASSUME"_tok), Parser<OmpClauseList>{})))
 
 TYPE_PARSER(sourced(construct<OmpEndAssumeDirective>(
-    verbatim(startOmpLine >> "END ASSUME"_tok))))
+    startOmpLine >> verbatim("END ASSUME"_tok))))
 
 TYPE_PARSER(sourced(
     construct<OpenMPAssumeConstruct>(Parser<OmpAssumeDirective>{} / endOmpLine,

flang/lib/Semantics/check-omp-structure.cpp

@@ -259,6 +259,55 @@ void OmpStructureChecker::CheckVariableListItem(
   }
 }
 
+void OmpStructureChecker::CheckDirectiveSpelling(
+    parser::CharBlock spelling, llvm::omp::Directive id) {
+  // Directive names that contain spaces can be spelled in the source without
+  // any of the spaces. Because of that getOpenMPKind* is not guaranteed to
+  // work with the source spelling as the argument.
+  //
+  // To verify the source spellings, we have to get the spelling for a given
+  // version, remove spaces and compare it with the source spelling (also
+  // with spaces removed).
+  auto removeSpaces = [](llvm::StringRef s) {
+    std::string n{s.str()};
+    for (auto it{n.begin()}; it != n.end();) {
+      it = isspace(*it) ? n.erase(it) : std::next(it);
+    }
+    return n;
+  };
+
+  std::string lowerNoWS{removeSpaces(
+      parser::ToLowerCaseLetters({spelling.begin(), spelling.size()}))};
+  llvm::StringRef ref(lowerNoWS);
+  if (ref.starts_with("end")) {
+    ref = ref.drop_front(3);
+  }
+
+  unsigned version{context_.langOptions().OpenMPVersion};
+
+  // For every "future" version v, check if the check if the corresponding
+  // spelling of id was introduced later than the current version. If so,
+  // and if that spelling matches the source spelling, issue a warning.
+  for (unsigned v : llvm::omp::getOpenMPVersions()) {
+    if (v <= version) {
+      continue;
+    }
+    llvm::StringRef name{llvm::omp::getOpenMPDirectiveName(id, v)};
+    auto [kind, versions]{llvm::omp::getOpenMPDirectiveKindAndVersions(name)};
+    assert(kind == id && "Directive kind mismatch");
+
+    if (static_cast<int>(version) >= versions.Min) {
+      continue;
+    }
+    if (ref == removeSpaces(name)) {
+      context_.Say(spelling,
+          "Directive spelling '%s' is introduced in a later OpenMP version, %s"_warn_en_US,
+          parser::ToUpperCaseLetters(ref), TryVersion(versions.Min));
+      break;
+    }
+  }
+}
+
 void OmpStructureChecker::CheckMultipleOccurrence(
     semantics::UnorderedSymbolSet &listVars,
     const std::list<parser::Name> &nameList, const parser::CharBlock &item,
@@ -436,7 +485,133 @@ void OmpStructureChecker::Leave(const parser::OmpDirectiveSpecification &) {
   }
 }
 
+template <typename Checker> struct DirectiveSpellingVisitor {
+  using Directive = llvm::omp::Directive;
+
+  DirectiveSpellingVisitor(Checker &&checker) : checker_(std::move(checker)) {}
+
+  template <typename T> bool Pre(const T &) { return true; }
+  template <typename T> void Post(const T &) {}
+
+  bool Pre(const parser::OmpSectionsDirective &x) {
+    checker_(x.source, x.v);
+    return false;
+  }
+  bool Pre(const parser::OpenMPDeclarativeAllocate &x) {
+    checker_(std::get<parser::Verbatim>(x.t).source, Directive::OMPD_allocate);
+    return false;
+  }
+  bool Pre(const parser::OmpDispatchDirective &x) {
+    checker_(std::get<parser::Verbatim>(x.t).source, Directive::OMPD_dispatch);
+    return false;
+  }
+  bool Pre(const parser::OmpErrorDirective &x) {
+    checker_(std::get<parser::Verbatim>(x.t).source, Directive::OMPD_error);
+    return false;
+  }
+  bool Pre(const parser::OmpNothingDirective &x) {
+    checker_(x.source, Directive::OMPD_nothing);
+    return false;
+  }
+  bool Pre(const parser::OpenMPExecutableAllocate &x) {
+    checker_(std::get<parser::Verbatim>(x.t).source, Directive::OMPD_allocate);
+    return false;
+  }
+  bool Pre(const parser::OpenMPAllocatorsConstruct &x) {
+    checker_(
+        std::get<parser::Verbatim>(x.t).source, Directive::OMPD_allocators);
+    return false;
+  }
+  bool Pre(const parser::OmpAssumeDirective &x) {
+    checker_(std::get<parser::Verbatim>(x.t).source, Directive::OMPD_assume);
+    return false;
+  }
+  bool Pre(const parser::OmpEndAssumeDirective &x) {
+    checker_(x.v.source, Directive::OMPD_assume);
+    return false;
+  }
+  bool Pre(const parser::OmpCriticalDirective &x) {
+    checker_(std::get<parser::Verbatim>(x.t).source, Directive::OMPD_critical);
+    return false;
+  }
+  bool Pre(const parser::OmpEndCriticalDirective &x) {
+    checker_(std::get<parser::Verbatim>(x.t).source, Directive::OMPD_critical);
+    return false;
+  }
+  bool Pre(const parser::OmpMetadirectiveDirective &x) {
+    checker_(
+        std::get<parser::Verbatim>(x.t).source, Directive::OMPD_metadirective);
+    return false;
+  }
+  bool Pre(const parser::OpenMPDeclarativeAssumes &x) {
+    checker_(std::get<parser::Verbatim>(x.t).source, Directive::OMPD_assumes);
+    return false;
+  }
+  bool Pre(const parser::OpenMPDeclareMapperConstruct &x) {
+    checker_(
+        std::get<parser::Verbatim>(x.t).source, Directive::OMPD_declare_mapper);
+    return false;
+  }
+  bool Pre(const parser::OpenMPDeclareReductionConstruct &x) {
+    checker_(std::get<parser::Verbatim>(x.t).source,
+        Directive::OMPD_declare_reduction);
+    return false;
+  }
+  bool Pre(const parser::OpenMPDeclareSimdConstruct &x) {
+    checker_(
+        std::get<parser::Verbatim>(x.t).source, Directive::OMPD_declare_simd);
+    return false;
+  }
+  bool Pre(const parser::OpenMPDeclareTargetConstruct &x) {
+    checker_(
+        std::get<parser::Verbatim>(x.t).source, Directive::OMPD_declare_target);
+    return false;
+  }
+  bool Pre(const parser::OmpDeclareVariantDirective &x) {
+    checker_(std::get<parser::Verbatim>(x.t).source,
+        Directive::OMPD_declare_variant);
+    return false;
+  }
+  bool Pre(const parser::OpenMPThreadprivate &x) {
+    checker_(
+        std::get<parser::Verbatim>(x.t).source, Directive::OMPD_threadprivate);
+    return false;
+  }
+  bool Pre(const parser::OpenMPRequiresConstruct &x) {
+    checker_(std::get<parser::Verbatim>(x.t).source, Directive::OMPD_requires);
+    return false;
+  }
+
+  bool Pre(const parser::OmpBlockDirective &x) {
+    checker_(x.source, x.v);
+    return false;
+  }
+
+  bool Pre(const parser::OmpLoopDirective &x) {
+    checker_(x.source, x.v);
+    return false;
+  }
+
+  bool Pre(const parser::OmpDirectiveSpecification &x) {
+    auto &name = std::get<parser::OmpDirectiveName>(x.t);
+    checker_(name.source, name.v);
+    return false;
+  }
+
+private:
+  Checker checker_;
+};
+
+template <typename T>
+DirectiveSpellingVisitor(T &&) -> DirectiveSpellingVisitor<T>;
+
 void OmpStructureChecker::Enter(const parser::OpenMPConstruct &x) {
+  DirectiveSpellingVisitor visitor(
+      [this](parser::CharBlock source, llvm::omp::Directive id) {
+        return CheckDirectiveSpelling(source, id);
+      });
+  parser::Walk(x, visitor);
+
   // Simd Construct with Ordered Construct Nesting check
   // We cannot use CurrentDirectiveIsNested() here because
   // PushContextAndClauseSets() has not been called yet, it is
@@ -461,6 +636,12 @@ void OmpStructureChecker::Leave(const parser::OpenMPConstruct &) {
 }
 
 void OmpStructureChecker::Enter(const parser::OpenMPDeclarativeConstruct &x) {
+  DirectiveSpellingVisitor visitor(
+      [this](parser::CharBlock source, llvm::omp::Directive id) {
+        return CheckDirectiveSpelling(source, id);
+      });
+  parser::Walk(x, visitor);
+
   EnterDirectiveNest(DeclarativeNest);
 }
 

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

@@ -163,6 +163,8 @@ class OmpStructureChecker
 private:
   bool CheckAllowedClause(llvmOmpClause clause);
   void CheckVariableListItem(const SymbolSourceMap &symbols);
+  void CheckDirectiveSpelling(
+      parser::CharBlock spelling, llvm::omp::Directive id);
   void CheckMultipleOccurrence(semantics::UnorderedSymbolSet &listVars,
       const std::list<parser::Name> &nameList, const parser::CharBlock &item,
       const std::string &clauseName);

flang/test/Semantics/OpenMP/future-directive-spellings.f90

@@ -0,0 +1,92 @@
+!RUN: %python %S/../test_errors.py %s %flang -fopenmp -fopenmp-version=52 -Werror
+
+! The directives to check:
+!   cancellation_point
+!   declare_mapper
+!   declare_reduction
+!   declare_simd
+!   declare_target
+!   declare_variant
+!   target_data
+!   target_enter_data
+!   target_exit_data
+!   target_update
+
+subroutine f00
+  implicit none
+  integer :: i
+
+  !$omp parallel
+  do i = 1, 10
+!WARNING: Directive spelling 'CANCELLATION_POINT' is introduced in a later OpenMP version, try -fopenmp-version=60
+    !$omp cancellation_point parallel
+  enddo
+  !$omp end parallel
+end
+
+subroutine f01
+  type :: t
+    integer :: x
+  end type
+!WARNING: Directive spelling 'DECLARE_MAPPER' is introduced in a later OpenMP version, try -fopenmp-version=60
+  !$omp declare_mapper(t :: v) map(v%x)
+end
+
+subroutine f02
+  type :: t
+    integer :: x
+  end type
+!WARNING: Directive spelling 'DECLARE_REDUCTION' is introduced in a later OpenMP version, try -fopenmp-version=60
+  !$omp declare_reduction(+ : t : omp_out%x = omp_out%x + omp_in%x)
+end
+
+subroutine f03
+!WARNING: Directive spelling 'DECLARE_SIMD' is introduced in a later OpenMP version, try -fopenmp-version=60
+  !$omp declare_simd
+end
+
+subroutine f04
+!WARNING: Directive spelling 'DECLARE_TARGET' is introduced in a later OpenMP version, try -fopenmp-version=60
+  !$omp declare_target
+end
+
+subroutine f05
+  implicit none
+  interface
+    subroutine g05
+    end
+  end interface
+!WARNING: Directive spelling 'DECLARE_VARIANT' is introduced in a later OpenMP version, try -fopenmp-version=60
+  !$omp declare_variant(g05) match(user={condition(.true.)})
+end
+
+subroutine f06
+  implicit none
+  integer :: i
+!WARNING: Directive spelling 'TARGET_DATA' is introduced in a later OpenMP version, try -fopenmp-version=60
+  !$omp target_data map(tofrom: i)
+  i = 0
+!WARNING: Directive spelling 'TARGET_DATA' is introduced in a later OpenMP version, try -fopenmp-version=60
+  !$omp end target_data
+end
+
+subroutine f07
+  implicit none
+  integer :: i
+!WARNING: Directive spelling 'TARGET_ENTER_DATA' is introduced in a later OpenMP version, try -fopenmp-version=60
+  !$omp target_enter_data map(to: i)
+end
+
+subroutine f08
+  implicit none
+  integer :: i
+!WARNING: Directive spelling 'TARGET_EXIT_DATA' is introduced in a later OpenMP version, try -fopenmp-version=60
+  !$omp target_exit_data map(from: i)
+end
+
+subroutine f09
+  implicit none
+  integer :: i
+!WARNING: Directive spelling 'TARGET_UPDATE' is introduced in a later OpenMP version, try -fopenmp-version=60
+  !$omp target_update to(i)
+end