[flang] [OpenMP] Implement no-multiple-appearance rule for DSA Clauses

DSA stands for Data-Sharing Attribute. This work is part of the
Name Resolution for OpenMP framework (data-refs on clauses part)

Based on 2.15.3: A list item that specifies a given variable may
not appear in more than one clause on the same directive, except that
a variable may be specified in both firstprivate and lastprivate clauses.

Through a temporary `std::set` of `const Symbol *` to keep track of
all the symbols on a certain OpenMP directive, we can determine whether
a variable `Name` (or `Symbol`, more accurately) has already appeared on
another DSA clause already, with the exception of FIRSTPRIVATE clause
and LASTPRIVATE clause. This rule applies to `/COMMON block/` also and
the source provenance shows on error message points to the `Name` between
slashes.

Added two more tests and changed some existing tests to accommodate
this commit. I intend to keep the `omp-clause-validity01.f90` test to
do the validity checks only.

Original-commit: flang-compiler/f18@0d7828c21e

flang/lib/semantics/resolve-names.cc

@@ -1043,6 +1043,11 @@ static const parser::Name *GetDesignatorNameIf(
   return dataRef ? std::get_if<parser::Name>(&dataRef->u) : nullptr;
 }
 
+static constexpr Symbol::Flags dataSharingAttributeFlags{
+    Symbol::Flag::OmpShared, Symbol::Flag::OmpPrivate,
+    Symbol::Flag::OmpFirstPrivate, Symbol::Flag::OmpLastPrivate,
+    Symbol::Flag::OmpReduction, Symbol::Flag::OmpLinear};
+
 static constexpr Symbol::Flags ompFlagsRequireNewSymbol{
     Symbol::Flag::OmpPrivate, Symbol::Flag::OmpLinear,
     Symbol::Flag::OmpFirstPrivate, Symbol::Flag::OmpLastPrivate,
@@ -1059,11 +1064,26 @@ public:
     return true;
   }
   void Post(const parser::OpenMPBlockConstruct &) { PopScope(); }
+  bool Pre(const parser::OmpBeginBlockDirective &) {
+    clear_dataSharingAttributeObject();
+    return true;
+  }
+  void Post(const parser::OmpBeginBlockDirective &) {
+    clear_dataSharingAttributeObject();
+  }
+
   bool Pre(const parser::OpenMPLoopConstruct &) {
     PushScope(Scope::Kind::Block, nullptr);
     return true;
   }
   void Post(const parser::OpenMPLoopConstruct &) { PopScope(); }
+  bool Pre(const parser::OmpBeginLoopDirective &) {
+    clear_dataSharingAttributeObject();
+    return true;
+  }
+  void Post(const parser::OmpBeginLoopDirective &) {
+    clear_dataSharingAttributeObject();
+  }
 
   bool Pre(const parser::OpenMPThreadprivate &x) {
     PushScope(Scope::Kind::Block, nullptr);
@@ -1090,6 +1110,14 @@ public:
     return false;
   }
 
+  void add_dataSharingAttributeObject(const Symbol *object) {
+    dataSharingAttributeObjects_.insert(object);
+  }
+  void clear_dataSharingAttributeObject() {
+    dataSharingAttributeObjects_.clear();
+  }
+  bool find_dataSharingAttributeObject(const Symbol *);
+
 protected:
   // TODO: resolve variables referenced in the OpenMP region
   void ResolveOmpObjectList(const parser::OmpObjectList &, Symbol::Flag);
@@ -1101,8 +1129,21 @@ protected:
   Symbol *DeclarePrivateAccessEntity(Symbol &, Symbol::Flag);
   Symbol *DeclareOrMarkOtherAccessEntity(const parser::Name &, Symbol::Flag);
   Symbol *DeclareOrMarkOtherAccessEntity(Symbol &, Symbol::Flag);
+  void CheckMultipleAppearances(
+      const parser::Name &, const Symbol *, Symbol::Flag);
+
+private:
+  std::set<const Symbol *> dataSharingAttributeObjects_;  // on one directive
 };
 
+bool OmpVisitor::find_dataSharingAttributeObject(const Symbol *object) {
+  auto it{dataSharingAttributeObjects_.find(object)};
+  if (it != dataSharingAttributeObjects_.end()) {
+    return true;
+  }
+  return false;
+}
+
 Symbol *OmpVisitor::ResolveOmpCommonBlockName(const parser::Name *name) {
   if (auto *prev{name ? currScope().parent().FindCommonBlock(name->source)
                       : nullptr}) {
@@ -1127,7 +1168,10 @@ void OmpVisitor::ResolveOmpObject(
   const auto *name{GetDesignatorNameIf(designator)};
   if (kind == parser::OmpObject::Kind::Object) {
     if (name) {
-      ResolveOmp(*name, ompFlag);
+      auto *symbol{ResolveOmp(*name, ompFlag)};
+      if (dataSharingAttributeFlags.test(ompFlag)) {
+        CheckMultipleAppearances(*name, symbol, ompFlag);
+      }
     } else if (const auto *designatorName{ResolveDesignator(designator)};
                designatorName->symbol) {
       if (const auto *details{
@@ -1145,6 +1189,7 @@ void OmpVisitor::ResolveOmpObject(
     }
   } else {  // common block
     if (auto *symbol{ResolveOmpCommonBlockName(name)}) {
+      CheckMultipleAppearances(*name, symbol, Symbol::Flag::OmpCommonBlock);
       // 2.15.3 When a named common block appears in a list, it has the same
       // meaning as if every explicit member of the common block appeared in
       // the list
@@ -1184,6 +1229,7 @@ Symbol *OmpVisitor::DeclarePrivateAccessEntity(
     name.symbol = &symbol;  // override resolution to parent
     return &symbol;
   } else {
+    prev.set(ompFlag);
     return &prev;
   }
 }
@@ -1196,6 +1242,7 @@ Symbol *OmpVisitor::DeclarePrivateAccessEntity(
     symbol.set(ompFlag);
     return &symbol;
   } else {
+    object.set(ompFlag);
     return &object;
   }
 }
@@ -1218,6 +1265,33 @@ Symbol *OmpVisitor::DeclareOrMarkOtherAccessEntity(
   return &object;
 }
 
+static bool WithMultipleAppearancesException(
+    const Symbol *symbol, Symbol::Flag ompFlag) {
+  return (ompFlag == Symbol::Flag::OmpFirstPrivate &&
+             symbol->test(Symbol::Flag::OmpLastPrivate)) ||
+      (ompFlag == Symbol::Flag::OmpLastPrivate &&
+          symbol->test(Symbol::Flag::OmpFirstPrivate));
+}
+
+void OmpVisitor::CheckMultipleAppearances(
+    const parser::Name &name, const Symbol *symbol, Symbol::Flag ompFlag) {
+  const Symbol *target{symbol};
+  if (ompFlagsRequireNewSymbol.test(ompFlag)) {
+    if (const auto *details{symbol->detailsIf<HostAssocDetails>()}) {
+      target = &details->symbol();
+    }
+  }
+  if (find_dataSharingAttributeObject(target) &&
+      !WithMultipleAppearancesException(symbol, ompFlag)) {
+    Say(name.source,
+        "'%s' appears in more than one data-sharing clause "
+        "on the same OpenMP directive"_err_en_US,
+        name.ToString());
+  } else {
+    add_dataSharingAttributeObject(target);
+  }
+}
+
 // Walk the parse tree and resolve names to symbols.
 class ResolveNamesVisitor : public virtual ScopeHandler,
                             public ModuleVisitor,

flang/lib/semantics/symbol.h

@@ -457,8 +457,9 @@ public:
       // OpenMP data-mapping attribute
       OmpMapTo, OmpMapFrom, OmpMapAlloc, OmpMapRelease, OmpMapDelete,
       // OpenMP miscellaneous flags
-      OmpReduction, OmpDeclareSimd, OmpDeclareTarget, OmpThreadprivate,
-      OmpDeclareReduction, OmpFlushed, OmpCriticalLock, OmpIfSpecified);
+      OmpCommonBlock, OmpReduction, OmpDeclareSimd, OmpDeclareTarget,
+      OmpThreadprivate, OmpDeclareReduction, OmpFlushed, OmpCriticalLock,
+      OmpIfSpecified);
   using Flags = common::EnumSet<Flag, Flag_enumSize>;
 
   const Scope &owner() const { return *owner_; }

flang/test/semantics/CMakeLists.txt

@@ -157,11 +157,13 @@ set(ERROR_TESTS
   omp-resolve01.f90
   omp-resolve02.f90
   omp-resolve03.f90
+  omp-resolve04.f90
   omp-symbol01.f90
   omp-symbol02.f90
   omp-symbol03.f90
   omp-symbol04.f90
   omp-symbol05.f90
+  omp-symbol06.f90
   omp-clause-validity01.f90
   omp-loop-association.f90
 #  omp-nested01.f90

flang/test/semantics/omp-clause-validity01.f90

@@ -241,7 +241,7 @@
   !$omp parallel
   b = 1
   !ERROR: LASTPRIVATE clause is not allowed on the SINGLE directive
-  !$omp single private(a) lastprivate(a)
+  !$omp single private(a) lastprivate(c)
   a = 3.14
   !ERROR: The COPYPRIVATE clause must not be used with the NOWAIT clause
   !ERROR: At most one NOWAIT clause can appear on the END SINGLE directive

flang/test/semantics/omp-resolve02.f90

@@ -22,6 +22,7 @@
   a = 3.
   b = 4
   !ERROR: LASTPRIVATE clause is not allowed on the PARALLEL directive
+  !ERROR: 'a' appears in more than one data-sharing clause on the same OpenMP directive
   !$omp parallel private(a) shared(b) lastprivate(a)
   a = 5.
   b = 6

flang/test/semantics/omp-resolve04.f90

@@ -0,0 +1,33 @@
+! Copyright (c) 2019, NVIDIA CORPORATION.  All rights reserved.
+!
+! Licensed under the Apache License, Version 2.0 (the "License");
+! you may not use this file except in compliance with the License.
+! You may obtain a copy of the License at
+!
+!     http://www.apache.org/licenses/LICENSE-2.0
+!
+! Unless required by applicable law or agreed to in writing, software
+! distributed under the License is distributed on an "AS IS" BASIS,
+! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+! See the License for the specific language governing permissions and
+! limitations under the License.
+
+!OPTIONS: -fopenmp
+
+! 2.15.3 Data-Sharing Attribute Clauses
+! A list item that specifies a given variable may not appear in more than
+! one clause on the same directive, except that a variable may be specified
+! in both firstprivate and lastprivate clauses.
+
+  common /c/ a, b
+  integer a(3), b
+
+  A = 1
+  B = 2
+  !ERROR: 'c' appears in more than one data-sharing clause on the same OpenMP directive
+  !$omp parallel shared(/c/,c) private(/c/)
+  a(1:2) = 3
+  B = 4
+  !$omp end parallel
+  print *, a, b, c
+end

flang/test/semantics/omp-symbol02.f90

@@ -24,7 +24,7 @@
   b = 2
   !DEF: /MainProgram1/c (Implicit) ObjectEntity REAL(4)
   c = 0
-  !$omp parallel  private(a,b) shared(c,c,d,d)
+  !$omp parallel  private(a,b) shared(c,d)
   !DEF: /MainProgram1/Block1/a (OmpPrivate) HostAssoc REAL(4)
   a = 3.
   !DEF: /MainProgram1/Block1/b (OmpPrivate) HostAssoc REAL(4)

flang/test/semantics/omp-symbol06.f90

@@ -0,0 +1,30 @@
+! Copyright (c) 2019, NVIDIA CORPORATION.  All rights reserved.
+!
+! Licensed under the Apache License, Version 2.0 (the "License");
+! you may not use this file except in compliance with the License.
+! You may obtain a copy of the License at
+!
+!     http://www.apache.org/licenses/LICENSE-2.0
+!
+! Unless required by applicable law or agreed to in writing, software
+! distributed under the License is distributed on an "AS IS" BASIS,
+! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+! See the License for the specific language governing permissions and
+! limitations under the License.
+
+!OPTIONS: -fopenmp
+
+! 2.15.3 Data-Sharing Attribute Clauses
+! A list item that specifies a given variable may not appear in more than
+! one clause on the same directive, except that a variable may be specified
+! in both firstprivate and lastprivate clauses.
+
+  !DEF: /MainProgram1/a (Implicit) ObjectEntity REAL(4)
+  a = 1.
+  !$omp parallel do  firstprivate(a) lastprivate(a)
+  !DEF: /MainProgram1/i (Implicit) ObjectEntity INTEGER(4)
+  do i=1,10
+     !DEF: /MainProgram1/Block1/a (OmpFirstPrivate, OmpLastPrivate) HostAssoc REAL(4)
+     a = 2.
+  end do
+end program