[flang][OpenMP] Reland Fix copyprivate semantic checks (#95799)

flang/include/flang/Semantics/tools.h

@@ -87,6 +87,7 @@ bool IsIntrinsicConcat(
 bool IsGenericDefinedOp(const Symbol &);
 bool IsDefinedOperator(SourceName);
 std::string MakeOpName(SourceName);
+bool IsCommonBlockContaining(const Symbol &, const Symbol &);
 
 // Returns true if maybeAncestor exists and is a proper ancestor of a
 // descendent scope (or symbol owner).  Will be false, unlike Scope::Contains(),

flang/lib/Semantics/resolve-directives.cpp

@@ -19,6 +19,7 @@
 #include "flang/Parser/parse-tree.h"
 #include "flang/Parser/tools.h"
 #include "flang/Semantics/expression.h"
+#include "flang/Semantics/tools.h"
 #include <list>
 #include <map>
 #include <sstream>
@@ -729,7 +730,6 @@ class OmpAttributeVisitor : DirectiveAttributeVisitor<llvm::omp::Directive> {
   void CheckNameInAllocateStmt(const parser::CharBlock &source,
       const parser::Name &ompObject, const parser::AllocateStmt &allocate);
 
-  bool HasSymbolInEnclosingScope(const Symbol &, Scope &);
   std::int64_t ordCollapseLevel{0};
 
   void AddOmpRequiresToScope(Scope &, WithOmpDeclarative::RequiresFlags,
@@ -2035,15 +2035,22 @@ void OmpAttributeVisitor::Post(const parser::OpenMPAllocatorsConstruct &x) {
 // and adjust the symbol for each Name if necessary
 void OmpAttributeVisitor::Post(const parser::Name &name) {
   auto *symbol{name.symbol};
+  auto IsPrivatizable = [](const Symbol *sym) {
+    return !IsProcedure(*sym) && !IsNamedConstant(*sym) &&
+        !sym->owner().IsDerivedType() &&
+        sym->owner().kind() != Scope::Kind::ImpliedDos &&
+        !sym->detailsIf<semantics::AssocEntityDetails>() &&
+        !sym->detailsIf<semantics::NamelistDetails>();
+  };
+
   if (symbol && !dirContext_.empty() && GetContext().withinConstruct) {
     // Exclude construct-names
     if (auto *details{symbol->detailsIf<semantics::MiscDetails>()}) {
       if (details->kind() == semantics::MiscDetails::Kind::ConstructName) {
         return;
       }
     }
-    if (!symbol->owner().IsDerivedType() && !IsProcedure(*symbol) &&
-        !IsObjectWithDSA(*symbol) && !IsNamedConstant(*symbol)) {
+    if (IsPrivatizable(symbol) && !IsObjectWithDSA(*symbol)) {
       // TODO: create a separate function to go through the rules for
       //       predetermined, explicitly determined, and implicitly
       //       determined data-sharing attributes (2.15.1.1).
@@ -2068,6 +2075,9 @@ void OmpAttributeVisitor::Post(const parser::Name &name) {
       if (found->test(semantics::Symbol::Flag::OmpThreadprivate))
         return;
     }
+    if (!IsPrivatizable(symbol)) {
+      return;
+    }
 
     // Implicitly determined DSAs
     // OMP 5.2 5.1.1 - Variables Referenced in a Construct
@@ -2085,16 +2095,22 @@ void OmpAttributeVisitor::Post(const parser::Name &name) {
         }
       }
 
-      // When handling each implicit rule, either a new private symbol is
-      // declared or the last declared symbol is used.
-      // In the latter case, it's necessary to insert a new symbol in the scope
-      // being processed, associated with the last declared symbol.
-      // This captures the fact that, although we are using the last declared
-      // symbol, its DSA could be different in this scope.
-      // Also, because of how symbols are collected in lowering, not inserting
-      // a new symbol in this scope could lead to the conclusion that the
-      // symbol was declared in this construct, which would result in wrong
-      // privatization code being generated.
+      // When handling each implicit rule for a given symbol, one of the
+      // following 3 actions may be taken:
+      // 1. Declare a new private symbol.
+      // 2. Create a new association symbol with no flags, that will represent
+      //    a shared symbol in the current scope. Note that symbols without
+      //    any private flags are considered as shared.
+      // 3. Use the last declared private symbol, by inserting a new symbol
+      //    in the scope being processed, associated with it.
+      //    If no private symbol was declared previously, then no association
+      //    is needed and the symbol from the enclosing scope will be
+      //    inherited by the current one.
+      //
+      // Because of how symbols are collected in lowering, not inserting a new
+      // symbol in the last case could lead to the conclusion that a symbol
+      // from an enclosing construct was declared in the current construct,
+      // which would result in wrong privatization code being generated.
       // Consider the following example:
       //
       // !$omp parallel default(private)              ! p1
@@ -2107,48 +2123,56 @@ void OmpAttributeVisitor::Post(const parser::Name &name) {
       // (p2), it would use the x symbol definition from the enclosing scope.
       // Then, when p2's default symbols were collected in lowering, the x
       // symbol from the outer parallel construct (p1) would be collected, as
-      // it would have the private flag set (note that symbols that don't have
-      // any private flag are considered as shared).
+      // it would have the private flag set.
       // This would make x appear to be defined in p2, causing it to be
       // privatized in p2 and its privatization in p1 to be skipped.
-      auto declNewSymbol = [&](Symbol::Flag flag) {
+      auto makePrivateSymbol = [&](Symbol::Flag flag) {
         Symbol *hostSymbol =
             lastDeclSymbol ? lastDeclSymbol : &symbol->GetUltimate();
         lastDeclSymbol = DeclarePrivateAccessEntity(
             *hostSymbol, flag, context_.FindScope(dirContext.directiveSource));
         return lastDeclSymbol;
       };
+      auto makeSharedSymbol = [&]() {
+        Symbol *hostSymbol =
+            lastDeclSymbol ? lastDeclSymbol : &symbol->GetUltimate();
+        MakeAssocSymbol(symbol->name(), *hostSymbol,
+            context_.FindScope(dirContext.directiveSource));
+      };
       auto useLastDeclSymbol = [&]() {
         if (lastDeclSymbol)
           MakeAssocSymbol(symbol->name(), *lastDeclSymbol,
               context_.FindScope(dirContext.directiveSource));
       };
 
+      bool taskGenDir = llvm::omp::taskGeneratingSet.test(dirContext.directive);
+      bool targetDir = llvm::omp::allTargetSet.test(dirContext.directive);
+      bool parallelDir = llvm::omp::allParallelSet.test(dirContext.directive);
+      bool teamsDir = llvm::omp::allTeamsSet.test(dirContext.directive);
+
       if (dsa.has_value()) {
-        useLastDeclSymbol();
+        if (dsa.value() == Symbol::Flag::OmpShared &&
+            (parallelDir || taskGenDir || teamsDir))
+          makeSharedSymbol();
+        // Private symbols will have been declared already.
         prevDSA = dsa;
         continue;
       }
 
-      bool taskGenDir = llvm::omp::taskGeneratingSet.test(dirContext.directive);
-      bool targetDir = llvm::omp::allTargetSet.test(dirContext.directive);
-      bool parallelDir = llvm::omp::allParallelSet.test(dirContext.directive);
-
       if (dirContext.defaultDSA == Symbol::Flag::OmpPrivate ||
           dirContext.defaultDSA == Symbol::Flag::OmpFirstPrivate ||
           dirContext.defaultDSA == Symbol::Flag::OmpShared) {
         // 1) default
         // Allowed only with parallel, teams and task generating constructs.
-        assert(parallelDir || taskGenDir ||
-            llvm::omp::allTeamsSet.test(dirContext.directive));
+        assert(parallelDir || taskGenDir || teamsDir);
         if (dirContext.defaultDSA != Symbol::Flag::OmpShared)
-          declNewSymbol(dirContext.defaultDSA);
+          makePrivateSymbol(dirContext.defaultDSA);
         else
-          useLastDeclSymbol();
+          makeSharedSymbol();
         dsa = dirContext.defaultDSA;
       } else if (parallelDir) {
         // 2) parallel -> shared
-        useLastDeclSymbol();
+        makeSharedSymbol();
         dsa = Symbol::Flag::OmpShared;
       } else if (!taskGenDir && !targetDir) {
         // 3) enclosing context
@@ -2161,12 +2185,12 @@ void OmpAttributeVisitor::Post(const parser::Name &name) {
         // TODO 5) dummy arg in orphaned taskgen construct -> firstprivate
         if (prevDSA == Symbol::Flag::OmpShared) {
           // 6) shared in enclosing context -> shared
-          useLastDeclSymbol();
+          makeSharedSymbol();
           dsa = Symbol::Flag::OmpShared;
         } else {
           // 7) firstprivate
           dsa = Symbol::Flag::OmpFirstPrivate;
-          declNewSymbol(*dsa)->set(Symbol::Flag::OmpImplicit);
+          makePrivateSymbol(*dsa)->set(Symbol::Flag::OmpImplicit);
         }
       }
       prevDSA = dsa;
@@ -2570,20 +2594,59 @@ void ResolveOmpTopLevelParts(
   });
 }
 
-void OmpAttributeVisitor::CheckDataCopyingClause(
-    const parser::Name &name, const Symbol &symbol, Symbol::Flag ompFlag) {
-  const auto *checkSymbol{&symbol};
+static bool IsSymbolInCommonBlock(const Symbol &symbol) {
+  // TODO Improve the performance of this predicate function.
+  //      Going through all symbols sequentially, in all common blocks, can be
+  //      slow when there are many symbols. A possible optimization is to add
+  //      an OmpInCommonBlock flag to Symbol, to make it possible to quickly
+  //      test if a given symbol is in a common block.
+  for (const auto &cb : symbol.owner().commonBlocks()) {
+    if (IsCommonBlockContaining(cb.second.get(), symbol)) {
+      return true;
+    }
+  }
+  return false;
+}
+
+static bool IsSymbolThreadprivate(const Symbol &symbol) {
   if (const auto *details{symbol.detailsIf<HostAssocDetails>()}) {
-    checkSymbol = &details->symbol();
+    return details->symbol().test(Symbol::Flag::OmpThreadprivate);
   }
+  return symbol.test(Symbol::Flag::OmpThreadprivate);
+}
 
+static bool IsSymbolPrivate(const Symbol &symbol) {
+  if (symbol.test(Symbol::Flag::OmpPrivate) ||
+      symbol.test(Symbol::Flag::OmpFirstPrivate)) {
+    return true;
+  }
+  // A symbol that has not gone through constructs that may privatize the
+  // original symbol may be predetermined as private.
+  // (OMP 5.2 5.1.1 - Variables Referenced in a Construct)
+  if (symbol == symbol.GetUltimate()) {
+    switch (symbol.owner().kind()) {
+    case Scope::Kind::MainProgram:
+    case Scope::Kind::Subprogram:
+    case Scope::Kind::BlockConstruct:
+      return !symbol.attrs().test(Attr::SAVE) &&
+          !symbol.attrs().test(Attr::PARAMETER) && !IsAssumedShape(symbol) &&
+          !IsSymbolInCommonBlock(symbol);
+    default:
+      return false;
+    }
+  }
+  return false;
+}
+
+void OmpAttributeVisitor::CheckDataCopyingClause(
+    const parser::Name &name, const Symbol &symbol, Symbol::Flag ompFlag) {
   if (ompFlag == Symbol::Flag::OmpCopyIn) {
     // List of items/objects that can appear in a 'copyin' clause must be
     // 'threadprivate'
-    if (!checkSymbol->test(Symbol::Flag::OmpThreadprivate)) {
+    if (!IsSymbolThreadprivate(symbol)) {
       context_.Say(name.source,
           "Non-THREADPRIVATE object '%s' in COPYIN clause"_err_en_US,
-          checkSymbol->name());
+          symbol.name());
     }
   } else if (ompFlag == Symbol::Flag::OmpCopyPrivate &&
       GetContext().directive == llvm::omp::Directive::OMPD_single) {
@@ -2596,18 +2659,13 @@ void OmpAttributeVisitor::CheckDataCopyingClause(
           "COPYPRIVATE variable '%s' may not appear on a PRIVATE or "
           "FIRSTPRIVATE clause on a SINGLE construct"_err_en_US,
           symbol.name());
-    } else {
+    } else if (!IsSymbolThreadprivate(symbol) && !IsSymbolPrivate(symbol)) {
       // List of items/objects that can appear in a 'copyprivate' clause must be
       // either 'private' or 'threadprivate' in enclosing context.
-      if (!checkSymbol->test(Symbol::Flag::OmpThreadprivate) &&
-          !(HasSymbolInEnclosingScope(symbol, currScope()) &&
-              (symbol.test(Symbol::Flag::OmpPrivate) ||
-                  symbol.test(Symbol::Flag::OmpFirstPrivate)))) {
-        context_.Say(name.source,
-            "COPYPRIVATE variable '%s' is not PRIVATE or THREADPRIVATE in "
-            "outer context"_err_en_US,
-            symbol.name());
-      }
+      context_.Say(name.source,
+          "COPYPRIVATE variable '%s' is not PRIVATE or THREADPRIVATE in "
+          "outer context"_err_en_US,
+          symbol.name());
     }
   }
 }
@@ -2677,12 +2735,6 @@ void OmpAttributeVisitor::CheckLabelContext(const parser::CharBlock source,
   }
 }
 
-bool OmpAttributeVisitor::HasSymbolInEnclosingScope(
-    const Symbol &symbol, Scope &scope) {
-  const auto symbols{scope.parent().GetSymbols()};
-  return llvm::is_contained(symbols, symbol);
-}
-
 // Goes through the names in an OmpObjectList and checks if each name appears
 // in the given allocate statement
 void OmpAttributeVisitor::CheckAllNamesInAllocateStmt(

flang/test/Lower/OpenMP/associate.f90

@@ -0,0 +1,38 @@
+! Check that constructs with associate and variables that have implicitly
+! determined DSAs are lowered properly.
+! RUN: %flang_fc1 -emit-hlfir -fopenmp -o - %s 2>&1 | FileCheck %s
+
+!CHECK-LABEL: func @_QPtest_parallel_assoc
+!CHECK:         omp.parallel {
+!CHECK-NOT:       hlfir.declare {{.*}} {uniq_name = "_QFtest_parallel_assocEa"}
+!CHECK-NOT:       hlfir.declare {{.*}} {uniq_name = "_QFtest_parallel_assocEb"}
+!CHECK:           omp.wsloop {
+!CHECK:           }
+!CHECK:         }
+!CHECK:         omp.parallel {
+!CHECK-NOT:       hlfir.declare {{.*}} {uniq_name = "_QFtest_parallel_assocEb"}
+!CHECK:           omp.wsloop {
+!CHECK:           }
+!CHECK:         }
+subroutine test_parallel_assoc()
+  integer, parameter :: l = 3
+  integer :: a(l)
+  integer :: i
+  a = 1
+
+  !$omp parallel do
+  do i = 1,l
+    associate (b=>a)
+      b(i) = b(i) * 2
+    end associate
+  enddo
+  !$omp end parallel do
+
+  !$omp parallel do default(private)
+  do i = 1,l
+    associate (b=>a)
+      b(i) = b(i) * 2
+    end associate
+  enddo
+  !$omp end parallel do
+end subroutine

flang/test/Lower/OpenMP/default-clause-implied-do-fix.f90

@@ -1,6 +1,6 @@
 !RUN: %flang_fc1 -emit-hlfir -fopenmp %s -o - | FileCheck %s
 
-!CHECK: @_QPsb
+!CHECK-LABEL: func @_QPsb
 subroutine sb(a)
   integer :: a(:)
 !CHECK: omp.parallel
@@ -9,3 +9,16 @@ subroutine sb(a)
     if (any(a/=(/(100,i=1,5)/))) print *, "OK"
   !$omp end parallel
 end subroutine
+
+!CHECK-LABEL: func @_QPsb2
+subroutine sb2()
+  integer, parameter :: SIZE=20
+  integer :: i, a(SIZE)
+
+! Just check that the construct below doesn't hit a TODO in lowering.
+!CHECK: omp.parallel
+  !$omp parallel
+    a = [ (i, i=1, SIZE) ]
+    print *, i
+  !$omp end parallel
+end subroutine