[Mlir-commits] [flang] [mlir] [flang][OpenMP] Diagnose threadprivate accesses in target device code (PR #237949)

Michael Klemm llvmlistbot at llvm.org
Mon Nov 2 04:49:26 PST 2026


https://github.com/mjklemm created https://github.com/llvm/llvm-project/pull/237949

The effect of an access to a threadprivate variable in a target region is unspecified. Flang did not diagnose such accesses. Instead, lowering failed MLIR verification, or device code generation crashed.

- Semantics: add OmpDeviceChecker, which reports accesses to threadprivate variables in TARGET regions and DECLARE TARGET procedures. When compiling for a target device, it also reports accesses in procedures that are implicitly DECLARE TARGET because they are called from device code.
- Add the omp-device-threadprivate-check FIR pass as a backstop. It also removes unused omp.threadprivate operations from device code.
- Report an error instead of crashing when translating omp.threadprivate for a target device.
- Lowering: bind threadprivate variables inside the omp.loop_nest of composite DISTRIBUTE PARALLEL DO [SIMD]. This fixes valid host code, e.g. TEAMS DISTRIBUTE PARALLEL DO.

Fixes: LCOMPILER-3073, LCOMPILER-2751

>From 35d6e1d21bfd88d099b68ad2222dd58942d92559 Mon Sep 17 00:00:00 2001
From: Michael Klemm <michael.klemm at amd.com>
Date: Mon, 2 Nov 2026 10:38:19 +0100
Subject: [PATCH] [flang][OpenMP] Diagnose threadprivate accesses in target
 device code

The effect of an access to a threadprivate variable in a target region
is unspecified. Flang did not diagnose such accesses. Instead, lowering
failed MLIR verification, or device code generation crashed.

- Semantics: add OmpDeviceChecker, which reports accesses to
  threadprivate variables in TARGET regions and DECLARE TARGET
  procedures. When compiling for a target device, it also reports
  accesses in procedures that are implicitly DECLARE TARGET because
  they are called from device code.
- Add the omp-device-threadprivate-check FIR pass as a backstop. It
  also removes unused omp.threadprivate operations from device code.
- Report an error instead of crashing when translating
  omp.threadprivate for a target device.
- Lowering: bind threadprivate variables inside the omp.loop_nest of
  composite DISTRIBUTE PARALLEL DO [SIMD]. This fixes valid host code,
  e.g. TEAMS DISTRIBUTE PARALLEL DO.

Fixes: LCOMPILER-3073, LCOMPILER-2751
Co-Authored-By: Claude <noreply at anthropic.com>
---
 .../include/flang/Optimizer/OpenMP/Passes.td  |  20 +
 flang/lib/Lower/OpenMP/OpenMP.cpp             |  27 +-
 flang/lib/Optimizer/OpenMP/CMakeLists.txt     |   1 +
 .../OpenMP/DeviceThreadprivateCheck.cpp       | 172 ++++++++
 flang/lib/Optimizer/Passes/Pipelines.cpp      |   1 +
 flang/lib/Semantics/CMakeLists.txt            |   1 +
 flang/lib/Semantics/check-omp-device.cpp      | 401 ++++++++++++++++++
 flang/lib/Semantics/check-omp-device.h        | 140 ++++++
 flang/lib/Semantics/semantics.cpp             |   2 +
 flang/test/Fir/basic-program.fir              |   1 +
 .../OpenMP/threadprivate-target-device.f90    |  13 +-
 .../threadprivate-unused-in-target-device.f90 |  45 ++
 .../threadprivate-distribute-parallel-do.f90  |  48 +++
 .../OpenMP/threadprivate-target-implicit.f90  | 124 ++++++
 .../Semantics/OpenMP/threadprivate-target.f90 | 157 +++++++
 .../omp-device-threadprivate-check.fir        |  96 +++++
 .../OpenMP/OpenMPToLLVMIRTranslation.cpp      |   9 +
 .../Target/LLVMIR/openmp-llvm-invalid.mlir    |  13 +
 18 files changed, 1259 insertions(+), 12 deletions(-)
 create mode 100644 flang/lib/Optimizer/OpenMP/DeviceThreadprivateCheck.cpp
 create mode 100644 flang/lib/Semantics/check-omp-device.cpp
 create mode 100644 flang/lib/Semantics/check-omp-device.h
 create mode 100644 flang/test/Integration/OpenMP/threadprivate-unused-in-target-device.f90
 create mode 100644 flang/test/Lower/OpenMP/threadprivate-distribute-parallel-do.f90
 create mode 100644 flang/test/Semantics/OpenMP/threadprivate-target-implicit.f90
 create mode 100644 flang/test/Semantics/OpenMP/threadprivate-target.f90
 create mode 100644 flang/test/Transforms/omp-device-threadprivate-check.fir

diff --git a/flang/include/flang/Optimizer/OpenMP/Passes.td b/flang/include/flang/Optimizer/OpenMP/Passes.td
index 08272d24252ee5..77b4fea3b296cd 100644
--- a/flang/include/flang/Optimizer/OpenMP/Passes.td
+++ b/flang/include/flang/Optimizer/OpenMP/Passes.td
@@ -117,6 +117,26 @@ def AutomapToTargetDataPass
   let dependentDialects = ["mlir::omp::OpenMPDialect"];
 }
 
+def DeviceThreadprivateCheckPass
+    : Pass<"omp-device-threadprivate-check", "::mlir::ModuleOp"> {
+  let summary = "Diagnose threadprivate variable accesses in target device "
+                "code";
+  let description = [{
+    Accessing a threadprivate variable in target device code is not supported.
+    Semantics diagnoses accesses in target regions and in procedures that are
+    explicitly or implicitly declare target, based on the calls it can see.
+    This pass is a backstop for accesses in procedures that only become
+    implicitly declare target through calls that are not visible to
+    semantics, e.g. calls generated during lowering. It must run after
+    implicit `declare_target` information has been propagated.
+
+    Threadprivate operations of variables that are not accessed in target
+    device code, e.g. variables of a used module, are removed from it.
+
+    The pass only has an effect when compiling for a target device.
+  }];
+}
+
 def UnimplementedDeviceCheckPass
     : Pass<"omp-unimplemented-device-check", "::mlir::ModuleOp"> {
   let summary = "Report not-yet-implemented situations on target device code";
diff --git a/flang/lib/Lower/OpenMP/OpenMP.cpp b/flang/lib/Lower/OpenMP/OpenMP.cpp
index 3ce793989dee30..4be9464d8d3018 100644
--- a/flang/lib/Lower/OpenMP/OpenMP.cpp
+++ b/flang/lib/Lower/OpenMP/OpenMP.cpp
@@ -1138,12 +1138,17 @@ static bool isThreadPrivate(lower::SymbolRef sym) {
 }
 #endif
 
+/// Create omp.threadprivate operations for all threadprivate symbols referenced
+/// in \p eval and rebind the symbols to them. The operations are created at
+/// the start of \p insertBlock or, if not given, of the current alloca block.
 static void threadPrivatizeVars(lower::AbstractConverter &converter,
-                                lower::pft::Evaluation &eval) {
+                                lower::pft::Evaluation &eval,
+                                mlir::Block *insertBlock = nullptr) {
   fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder();
   mlir::Location currentLocation = converter.getCurrentLocation();
   mlir::OpBuilder::InsertionGuard guard(firOpBuilder);
-  firOpBuilder.setInsertionPointToStart(firOpBuilder.getAllocaBlock());
+  firOpBuilder.setInsertionPointToStart(
+      insertBlock ? insertBlock : firOpBuilder.getAllocaBlock());
 
   // If the symbol corresponds to the original ThreadprivateOp, use the symbol
   // value from that operation to create one ThreadprivateOp copy operation
@@ -1929,7 +1934,10 @@ static void createBodyOfOp(mlir::Operation &op, const OpWithBodyGenInfo &info,
   }
 
   if (info.dir == llvm::omp::Directive::OMPD_parallel) {
-    threadPrivatizeVars(info.converter, info.eval);
+    // A composite omp.parallel may only contain its nested omp.distribute.
+    // The threadprivate operations are created inside the loop nest instead.
+    if (!info.genSkeletonOnly)
+      threadPrivatizeVars(info.converter, info.eval);
     if (info.clauses) {
       firOpBuilder.setInsertionPoint(marker);
       ClauseProcessor(info.converter, info.semaCtx, *info.clauses)
@@ -5337,7 +5345,13 @@ static mlir::omp::DistributeOp genCompositeDistributeParallelDo(
   genLoopNestOp(converter, symTable, semaCtx, eval, loc, queue, doItem,
                 loopNestClauseOps, iv,
                 {{distributeOp, distributeArgs}, {wsloopOp, wsloopArgs}},
-                llvm::omp::Directive::OMPD_distribute_parallel_do, dsp);
+                llvm::omp::Directive::OMPD_distribute_parallel_do, dsp,
+                [&](mlir::Operation *loopNestOp) {
+                  // Threadprivate variables cannot be bound in the composite
+                  // omp.parallel, so do it at the start of the loop body.
+                  threadPrivatizeVars(converter, eval,
+                                      &loopNestOp->getRegion(0).front());
+                });
 
   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
   fir::FirOpBuilder::InsertionGuard guard(builder);
@@ -5463,7 +5477,10 @@ static mlir::omp::DistributeOp genCompositeDistributeParallelDoSimd(
                  {wsloopOp, wsloopArgs},
                  {simdOp, simdArgs}},
                 llvm::omp::Directive::OMPD_distribute_parallel_do_simd,
-                simdItemDSP);
+                simdItemDSP, [&](mlir::Operation *loopNestOp) {
+                  threadPrivatizeVars(converter, eval,
+                                      &loopNestOp->getRegion(0).front());
+                });
 
   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
   fir::FirOpBuilder::InsertionGuard guard(builder);
diff --git a/flang/lib/Optimizer/OpenMP/CMakeLists.txt b/flang/lib/Optimizer/OpenMP/CMakeLists.txt
index 4cc7625bb07f3f..f39f5b22490213 100644
--- a/flang/lib/Optimizer/OpenMP/CMakeLists.txt
+++ b/flang/lib/Optimizer/OpenMP/CMakeLists.txt
@@ -2,6 +2,7 @@ get_property(dialect_libs GLOBAL PROPERTY MLIR_DIALECT_LIBS)
 
 add_flang_library(FlangOpenMPTransforms
   AutomapToTargetData.cpp
+  DeviceThreadprivateCheck.cpp
   DoConcurrentConversion.cpp
   GenericLoopConversion.cpp
   MapsForPrivatizedSymbols.cpp
diff --git a/flang/lib/Optimizer/OpenMP/DeviceThreadprivateCheck.cpp b/flang/lib/Optimizer/OpenMP/DeviceThreadprivateCheck.cpp
new file mode 100644
index 00000000000000..a559bd1ab63d72
--- /dev/null
+++ b/flang/lib/Optimizer/OpenMP/DeviceThreadprivateCheck.cpp
@@ -0,0 +1,172 @@
+//===- DeviceThreadprivateCheck.cpp ---------------------------------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+//
+// Diagnose accesses to threadprivate variables in target device code and
+// remove the threadprivate operations of unaccessed variables from it.
+//
+//===----------------------------------------------------------------------===//
+
+#include "flang/Optimizer/OpenMP/Passes.h"
+
+#include "flang/Optimizer/Dialect/FIROps.h"
+#include "flang/Optimizer/Dialect/FortranVariableInterface.h"
+#include "flang/Optimizer/HLFIR/HLFIROps.h"
+#include "flang/Optimizer/Support/InternalNames.h"
+#include "mlir/Dialect/OpenMP/OpenMPDialect.h"
+#include "mlir/IR/BuiltinOps.h"
+#include "llvm/ADT/SetVector.h"
+
+using namespace mlir;
+
+namespace flangomp {
+#define GEN_PASS_DEF_DEVICETHREADPRIVATECHECKPASS
+#include "flang/Optimizer/OpenMP/Passes.h.inc"
+} // namespace flangomp
+
+/// Check whether the given operation is part of target device code, i.e. it is
+/// inside of an omp.target region or of a function that is declare target for
+/// the device.
+static bool isDeviceCode(Operation *op) {
+  if (op->getParentOfType<omp::TargetOp>())
+    return true;
+
+  if (auto declareTargetOp = op->getParentOfType<omp::DeclareTargetInterface>())
+    if (omp::DeclareTargetAttr declareTargetAttr =
+            declareTargetOp.getDeclareTarget())
+      return declareTargetAttr.getDeviceType() !=
+             omp::DeclareTargetDeviceType::host;
+
+  return false;
+}
+
+/// Operations that only compute an address or a descriptor from their operands
+/// without accessing the memory behind them.
+static bool isAddressComputation(Operation *op) {
+  return isa<fir::FortranVariableOpInterface, fir::CoordinateOp,
+             fir::ConvertOp, fir::EmboxOp, fir::ReboxOp, fir::BoxAddrOp,
+             fir::ArrayCoorOp, hlfir::DesignateOp>(op);
+}
+
+/// Follow the uses of \p value through address computations, which are added
+/// to \p addressOps. Return the first operation accessing the memory, if any.
+static Operation *findAccess(Value value,
+                             llvm::SetVector<Operation *> &addressOps) {
+  Operation *access = nullptr;
+  for (Operation *user : value.getUsers()) {
+    if (!isAddressComputation(user)) {
+      // Keep the access that comes first in the block, if possible.
+      if (!access || (user->getBlock() == access->getBlock() &&
+                      user->isBeforeInBlock(access)))
+        access = user;
+      continue;
+    }
+    if (!addressOps.insert(user))
+      continue;
+    for (Value result : user->getResults())
+      if (Operation *resultAccess = findAccess(result, addressOps))
+        if (!access || (resultAccess->getBlock() == access->getBlock() &&
+                        resultAccess->isBeforeInBlock(access)))
+          access = resultAccess;
+  }
+  return access;
+}
+
+/// Return the global holding the threadprivate variable of \p op, if found.
+static fir::GlobalOp getThreadprivateGlobal(omp::ThreadprivateOp op) {
+  Value addr = op.getSymAddr();
+  while (Operation *defOp = addr.getDefiningOp()) {
+    if (auto addrOf = dyn_cast<fir::AddrOfOp>(defOp))
+      return SymbolTable::lookupNearestSymbolFrom<fir::GlobalOp>(
+          op, addrOf.getSymbol());
+    if (auto varOp = dyn_cast<fir::FortranVariableOpInterface>(defOp))
+      addr = varOp.getBase();
+    else if (auto convert = dyn_cast<fir::ConvertOp>(defOp))
+      addr = convert.getValue();
+    else
+      break;
+  }
+  return nullptr;
+}
+
+/// Describe the threadprivate variable stored in \p global for a diagnostic.
+static std::string describeThreadprivate(fir::GlobalOp global) {
+  if (!global)
+    return "a THREADPRIVATE variable";
+
+  llvm::StringRef symName = global.getSymName();
+  if (global.getLinkage() == fir::LinkageEnum::Common) {
+    // Common block names are mangled like external procedure names.
+    llvm::StringRef name = symName;
+    if (name == "__BLNK__")
+      name = "";
+    else
+      name.consume_back("_");
+    return ("THREADPRIVATE common block '/" + name + "/'").str();
+  }
+
+  auto [kind, deconstructed] = fir::NameUniquer::deconstruct(symName);
+  llvm::StringRef name =
+      kind == fir::NameUniquer::NameKind::VARIABLE ? deconstructed.name
+                                                   : symName;
+  return ("THREADPRIVATE variable '" + name + "'").str();
+}
+
+namespace {
+class DeviceThreadprivateCheckPass
+    : public flangomp::impl::DeviceThreadprivateCheckPassBase<
+          DeviceThreadprivateCheckPass> {
+
+  void runOnOperation() override {
+    // Only run checks when compiling for a target device.
+    auto offloadModule = dyn_cast<omp::OffloadModuleInterface>(*getOperation());
+    if (!offloadModule || !offloadModule.getIsTargetDevice())
+      return;
+
+    llvm::SmallVector<omp::ThreadprivateOp> threadprivateOps;
+    getOperation()->walk([&](omp::ThreadprivateOp op) {
+      if (isDeviceCode(op))
+        threadprivateOps.push_back(op);
+    });
+
+    bool errorsEmitted = false;
+    for (omp::ThreadprivateOp op : threadprivateOps) {
+      llvm::SetVector<Operation *> addressOps;
+      if (Operation *access = findAccess(op.getTlsAddr(), addressOps)) {
+        fir::GlobalOp global = getThreadprivateGlobal(op);
+        InFlightDiagnostic diag = access->emitError()
+                                  << describeThreadprivate(global)
+                                  << " cannot be accessed in target device "
+                                     "code";
+        if (global)
+          diag.attachNote(global.getLoc()) << "declared here";
+        errorsEmitted = true;
+        continue;
+      }
+
+      // The variable is declared, but never accessed. Remove the threadprivate
+      // operation, which cannot be translated for the device, together with
+      // the address computations depending on it. All users of these address
+      // computations are in the set, so there is always one without remaining
+      // uses that can be erased.
+      llvm::SmallVector<Operation *> pending(addressOps.begin(),
+                                             addressOps.end());
+      while (!pending.empty()) {
+        auto *unused = llvm::find_if(
+            pending, [](Operation *addressOp) { return addressOp->use_empty(); });
+        assert(unused != pending.end() && "expected an unused operation");
+        (*unused)->erase();
+        pending.erase(unused);
+      }
+      op->erase();
+    }
+
+    if (errorsEmitted)
+      signalPassFailure();
+  }
+};
+} // namespace
diff --git a/flang/lib/Optimizer/Passes/Pipelines.cpp b/flang/lib/Optimizer/Passes/Pipelines.cpp
index 1608d29d2db6e2..8f9458175a267c 100644
--- a/flang/lib/Optimizer/Passes/Pipelines.cpp
+++ b/flang/lib/Optimizer/Passes/Pipelines.cpp
@@ -483,6 +483,7 @@ void createDefaultFIRCodeGenPassPipeline(mlir::PassManager &pm,
     // Propagate implicit declare target information early in order to diagnose
     // target device not-yet-implemented cases based on FIR.
     pm.addPass(mlir::omp::createMarkDeclareTargetPass());
+    pm.addPass(flangomp::createDeviceThreadprivateCheckPass());
     pm.addPass(flangomp::createUnimplementedDeviceCheckPass());
   }
 
diff --git a/flang/lib/Semantics/CMakeLists.txt b/flang/lib/Semantics/CMakeLists.txt
index 6fc45bdb449d96..d12830e52ca2eb 100644
--- a/flang/lib/Semantics/CMakeLists.txt
+++ b/flang/lib/Semantics/CMakeLists.txt
@@ -21,6 +21,7 @@ add_flang_library(FortranSemantics
   check-namelist.cpp
   check-nullify.cpp
   check-omp-atomic.cpp
+  check-omp-device.cpp
   check-omp-loop.cpp
   check-omp-variant.cpp
   check-omp-structure.cpp
diff --git a/flang/lib/Semantics/check-omp-device.cpp b/flang/lib/Semantics/check-omp-device.cpp
new file mode 100644
index 00000000000000..c2bdd0dc93df59
--- /dev/null
+++ b/flang/lib/Semantics/check-omp-device.cpp
@@ -0,0 +1,401 @@
+//===-- lib/Semantics/check-omp-device.cpp --------------------------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#include "check-omp-device.h"
+
+#include "flang/Evaluate/tools.h"
+#include "flang/Evaluate/traverse.h"
+#include "flang/Parser/parse-tree.h"
+#include "flang/Semantics/openmp-directive-sets.h"
+#include "flang/Semantics/symbol.h"
+#include "flang/Semantics/tools.h"
+
+#include <deque>
+#include <string>
+
+namespace Fortran::semantics {
+
+// Collects the procedures called in an expression. Procedures passed as
+// actual arguments are not called by the expression, so they are skipped.
+struct CalleeCollector
+    : public evaluate::Traverse<CalleeCollector, std::vector<const Symbol *>> {
+  using Result = std::vector<const Symbol *>;
+  using Base = evaluate::Traverse<CalleeCollector, Result>;
+  using Base::operator();
+  CalleeCollector() : Base{*this} {}
+  Result Default() { return {}; }
+  Result Combine(Result &&a, Result &&b) {
+    a.insert(a.end(), b.begin(), b.end());
+    return std::move(a);
+  }
+  Result operator()(const evaluate::ProcedureDesignator &) const { return {}; }
+  Result operator()(const evaluate::ProcedureRef &x) const {
+    Result result{(*this)(x.arguments())};
+    if (const Symbol *callee{x.proc().GetSymbol()}) {
+      result.push_back(callee);
+    }
+    return result;
+  }
+};
+
+static bool IsThreadprivate(const Symbol &symbol) {
+  if (const auto *details{symbol.detailsIf<CommonBlockDetails>()}) {
+    return llvm::any_of(details->objects(), [](const MutableSymbolRef &object) {
+      return object->GetUltimate().test(Symbol::Flag::OmpThreadprivate);
+    });
+  }
+  return symbol.test(Symbol::Flag::OmpThreadprivate);
+}
+
+static std::string GetVariableName(const Symbol &symbol) {
+  if (symbol.has<CommonBlockDetails>()) {
+    return "/" + symbol.name().ToString() + "/";
+  }
+  return symbol.name().ToString();
+}
+
+OmpDeviceChecker::OmpDeviceChecker(SemanticsContext &context)
+    : context_{context},
+      isTargetDevice_{context.langOptions().OpenMPIsTargetDevice} {}
+
+void OmpDeviceChecker::Leave(const parser::Program &) {
+  if (isTargetDevice_) {
+    CheckImplicitDeclareTarget();
+  }
+}
+
+void OmpDeviceChecker::Enter(const parser::SubroutineSubprogram &x) {
+  const auto &stmt{std::get<parser::Statement<parser::SubroutineStmt>>(x.t)};
+  EnterProcedure(std::get<parser::Name>(stmt.statement.t).symbol);
+}
+
+void OmpDeviceChecker::Leave(const parser::SubroutineSubprogram &) {
+  LeaveProcedure();
+}
+
+void OmpDeviceChecker::Enter(const parser::FunctionSubprogram &x) {
+  const auto &stmt{std::get<parser::Statement<parser::FunctionStmt>>(x.t)};
+  EnterProcedure(std::get<parser::Name>(stmt.statement.t).symbol);
+}
+
+void OmpDeviceChecker::Leave(const parser::FunctionSubprogram &) {
+  LeaveProcedure();
+}
+
+void OmpDeviceChecker::Enter(const parser::SeparateModuleSubprogram &x) {
+  const auto &stmt{std::get<parser::Statement<parser::MpSubprogramStmt>>(x.t)};
+  EnterProcedure(stmt.statement.v.symbol);
+}
+
+void OmpDeviceChecker::Leave(const parser::SeparateModuleSubprogram &) {
+  LeaveProcedure();
+}
+
+void OmpDeviceChecker::Enter(const parser::ExecutionPart &) {
+  inExecutionPart_ = true;
+}
+
+void OmpDeviceChecker::Leave(const parser::ExecutionPart &) {
+  inExecutionPart_ = false;
+}
+
+void OmpDeviceChecker::Enter(const parser::EntryStmt &x) {
+  const Symbol *procedure{CurrentProcedure()};
+  const Symbol *entry{std::get<parser::Name>(x.t).symbol};
+  if (procedure && entry) {
+    aliases_[entry] = procedure;
+  }
+}
+
+void OmpDeviceChecker::Leave(const parser::OmpBeginDirective &x) {
+  // The body of a TARGET construct is device code, but its clauses are
+  // evaluated by the encountering task.
+  if (llvm::omp::allTargetSet.test(x.DirId())) {
+    targets_.push_back(&x);
+  }
+}
+
+void OmpDeviceChecker::Leave(const parser::OmpBlockConstruct &x) {
+  LeaveConstruct(x.BeginDir());
+}
+
+void OmpDeviceChecker::Leave(const parser::OpenMPLoopConstruct &x) {
+  LeaveConstruct(x.BeginDir());
+}
+
+void OmpDeviceChecker::Enter(const parser::OmpClause &x) {
+  clauses_.push_back(x.Id());
+}
+
+void OmpDeviceChecker::Leave(const parser::OmpClause &) { clauses_.pop_back(); }
+
+void OmpDeviceChecker::Enter(const parser::OmpObjectList &) {
+  // THREADPRIVATE variables in clauses are diagnosed by the clause checks,
+  // except in the clauses that allow them. Those clauses access them.
+  bool skip{clauses_.empty() ||
+      (clauses_.back() != llvm::omp::Clause::OMPC_copyin &&
+          clauses_.back() != llvm::omp::Clause::OMPC_copyprivate)};
+  skippedObjectLists_.push_back(skip);
+  skipDepth_ += skip;
+}
+
+void OmpDeviceChecker::Leave(const parser::OmpObjectList &) {
+  skipDepth_ -= skippedObjectLists_.back();
+  skippedObjectLists_.pop_back();
+}
+
+// Objects in directive arguments (e.g. FLUSH) are not checked.
+void OmpDeviceChecker::Enter(const parser::OmpArgumentList &) { ++skipDepth_; }
+
+void OmpDeviceChecker::Leave(const parser::OmpArgumentList &) { --skipDepth_; }
+
+// DATA statements initialize variables before execution starts.
+void OmpDeviceChecker::Enter(const parser::DataStmt &) { ++skipDepth_; }
+
+void OmpDeviceChecker::Leave(const parser::DataStmt &) { --skipDepth_; }
+
+void OmpDeviceChecker::Enter(const parser::Name &x) {
+  if (inExecutionPart_ && skipDepth_ == 0 && x.symbol) {
+    CheckReference(x.source, *x.symbol);
+  }
+}
+
+void OmpDeviceChecker::Enter(const parser::Expr &x) {
+  // The analyzed outermost expression contains all calls.
+  if (exprDepth_++ == 0 && inExecutionPart_ && skipDepth_ == 0) {
+    if (const SomeExpr *expr{GetExpr(context_, x)}) {
+      RecordCalls(x.source, *expr);
+    }
+  }
+}
+
+void OmpDeviceChecker::Leave(const parser::Expr &) { --exprDepth_; }
+
+void OmpDeviceChecker::Enter(const parser::CallStmt &x) {
+  if (inExecutionPart_ && x.typedCall) {
+    if (const Symbol *callee{x.typedCall->proc().GetSymbol()}) {
+      RecordCall(x.source, *callee);
+    }
+  }
+}
+
+void OmpDeviceChecker::Enter(const parser::AssignmentStmt &x) {
+  // Defined assignment
+  if (inExecutionPart_) {
+    if (const auto *assignment{GetAssignment(x)}) {
+      if (const auto *call{
+              std::get_if<evaluate::ProcedureRef>(&assignment->u)}) {
+        if (const Symbol *callee{call->proc().GetSymbol()}) {
+          RecordCall(std::get<parser::Variable>(x.t).GetSource(), *callee);
+        }
+      }
+    }
+  }
+}
+
+void OmpDeviceChecker::EnterProcedure(const Symbol *symbol) {
+  procedures_.push_back(symbol);
+  if (!symbol) {
+    return;
+  }
+  ProcedureInfo &info{procedureInfo_[symbol]};
+  const auto *details{symbol->detailsIf<SubprogramDetails>()};
+  if (!details) {
+    return;
+  }
+  // DECLARE TARGET is recorded in the details of the procedure, or of the
+  // interface of a separate module procedure. (The OmpDeclareTarget flag may
+  // be set on a host-associated symbol of the procedure instead.)
+  const SubprogramDetails *declaration{details};
+  if (const Symbol *interface{details->moduleInterface()}) {
+    // Calls of a separate module procedure refer to its interface.
+    const Symbol &ultimate{interface->GetUltimate()};
+    aliases_[&ultimate] = symbol;
+    if (details->ompDeclTarget().empty()) {
+      if (const auto *interfaceDetails{
+              ultimate.detailsIf<SubprogramDetails>()}) {
+        declaration = interfaceDetails;
+      }
+    }
+  }
+  if (!declaration->ompDeclTarget().empty()) {
+    info.isExplicitDeclareTarget = true;
+    const auto &deviceType{declaration->ompDeclTargetDeviceType()};
+    info.isExplicitDevice =
+        !deviceType || *deviceType != common::OmpDeviceType::Host;
+  }
+}
+
+void OmpDeviceChecker::LeaveProcedure() { procedures_.pop_back(); }
+
+void OmpDeviceChecker::LeaveConstruct(const parser::OmpBeginDirective &x) {
+  if (!targets_.empty() && targets_.back() == &x) {
+    targets_.pop_back();
+  }
+}
+
+OmpDeviceChecker::DeviceContext OmpDeviceChecker::GetDeviceContext() const {
+  if (!targets_.empty()) {
+    return DeviceContext::TargetRegion;
+  }
+  if (const Symbol *procedure{CurrentProcedure()};
+      procedure && inExecutionPart_) {
+    if (auto iter{procedureInfo_.find(procedure)};
+        iter != procedureInfo_.end() && iter->second.isExplicitDevice) {
+      return DeviceContext::DeclareTarget;
+    }
+  }
+  return DeviceContext::None;
+}
+
+const Symbol *OmpDeviceChecker::CurrentProcedure() const {
+  return procedures_.empty() ? nullptr : procedures_.back();
+}
+
+void OmpDeviceChecker::CheckReference(parser::CharBlock source,
+    const Symbol &symbol, const Symbol *statementFunction) {
+  // Resolve use, host, and construct associations.
+  const Symbol &root{GetAssociationRoot(symbol)};
+  if (const auto *details{root.detailsIf<SubprogramDetails>()}) {
+    // The expression of a statement function is evaluated where the statement
+    // function is referenced.
+    if (const auto &expr{details->stmtFunction()};
+        expr && expanding_.insert(&root).second) {
+      const Symbol *outermost{statementFunction ? statementFunction : &root};
+      for (const Symbol &referenced : evaluate::CollectSymbols(*expr)) {
+        CheckReference(source, referenced, outermost);
+      }
+      RecordCalls(source, *expr);
+      expanding_.erase(&root);
+    }
+  } else if (IsThreadprivate(root)) {
+    CheckAccess(Access{source, &root, statementFunction});
+  }
+}
+
+void OmpDeviceChecker::CheckAccess(const Access &access) {
+  DeviceContext context{GetDeviceContext()};
+  if (context == DeviceContext::None) {
+    // Diagnosed later if the procedure turns out to be device code.
+    if (const Symbol *procedure{CurrentProcedure()};
+        procedure && isTargetDevice_) {
+      procedureInfo_[procedure].accesses.push_back(access);
+    }
+    return;
+  }
+  // OpenMP 5.2: 5.2 threadprivate directive restriction: the effect of an
+  // access to a threadprivate variable in a target region is unspecified.
+  std::string name{GetVariableName(*access.variable)};
+  auto &message{context_.Say(access.source,
+      "A THREADPRIVATE variable '%s' cannot be accessed in a %s"_err_en_US,
+      name,
+      context == DeviceContext::TargetRegion ? "TARGET region"
+                                             : "DECLARE TARGET procedure")};
+  if (access.statementFunction) {
+    message.Attach(access.statementFunction->name(),
+        "'%s' is accessed by statement function '%s'"_en_US, name,
+        access.statementFunction->name());
+  }
+}
+
+void OmpDeviceChecker::RecordCall(
+    parser::CharBlock source, const Symbol &callee) {
+  if (!isTargetDevice_) {
+    return;
+  }
+  Call call{source, &callee, CurrentProcedure(), GetDeviceContext()};
+  if (call.context != DeviceContext::None) {
+    deviceCalls_.push_back(call);
+  } else if (call.caller) {
+    procedureInfo_[call.caller].calls.push_back(call);
+  }
+}
+
+void OmpDeviceChecker::RecordCalls(
+    parser::CharBlock source, const SomeExpr &expr) {
+  for (const Symbol *callee : CalleeCollector{}(expr)) {
+    RecordCall(source, *callee);
+  }
+}
+
+// Returns the definition in the compilation unit of the called procedure.
+const Symbol *OmpDeviceChecker::FindDefinition(const Symbol &callee) const {
+  auto lookup{[&](const Symbol *symbol) -> const Symbol * {
+    if (auto iter{aliases_.find(symbol)}; iter != aliases_.end()) {
+      symbol = iter->second;
+    }
+    return procedureInfo_.count(symbol) ? symbol : nullptr;
+  }};
+  const Symbol *symbol{&callee.GetUltimate()};
+  if (const auto *binding{symbol->detailsIf<ProcBindingDetails>()}) {
+    symbol = &binding->symbol().GetUltimate();
+  }
+  if (const Symbol *definition{lookup(symbol)}) {
+    return definition;
+  }
+  // An external procedure called through an interface.
+  if (const Symbol *global{FindGlobal(*symbol)}) {
+    return lookup(global);
+  }
+  return nullptr;
+}
+
+// A procedure that is called from device code and is not explicitly DECLARE
+// TARGET is implicitly DECLARE TARGET for the device. Propagate this along the
+// calls, like the implicit DECLARE TARGET marking during lowering, and check
+// the accesses of the reached procedures.
+void OmpDeviceChecker::CheckImplicitDeclareTarget() {
+  // The call through which each procedure was first reached.
+  llvm::DenseMap<const Symbol *, Call> reachedBy;
+  std::deque<Call> worklist(deviceCalls_.begin(), deviceCalls_.end());
+  while (!worklist.empty()) {
+    Call call{worklist.front()};
+    worklist.pop_front();
+    const Symbol *procedure{FindDefinition(*call.callee)};
+    if (!procedure) {
+      continue;
+    }
+    const ProcedureInfo &info{procedureInfo_.find(procedure)->second};
+    if (info.isExplicitDeclareTarget ||
+        !reachedBy.try_emplace(procedure, call).second) {
+      continue;
+    }
+    for (const Access &access : info.accesses) {
+      std::string name{GetVariableName(*access.variable)};
+      auto &message{context_.Say(access.source,
+          "A THREADPRIVATE variable '%s' cannot be accessed in procedure '%s', which is implicitly DECLARE TARGET"_err_en_US,
+          name, procedure->name())};
+      if (access.statementFunction) {
+        message.Attach(access.statementFunction->name(),
+            "'%s' is accessed by statement function '%s'"_en_US, name,
+            access.statementFunction->name());
+      }
+      // Explain how the procedure is called from device code.
+      for (const Symbol *callee{procedure};;) {
+        const Call &edge{reachedBy.find(callee)->second};
+        if (edge.context == DeviceContext::TargetRegion) {
+          message.Attach(edge.source,
+              "'%s' is called from a TARGET region here"_en_US, callee->name());
+          break;
+        }
+        if (edge.context == DeviceContext::DeclareTarget) {
+          message.Attach(edge.source,
+              "'%s' is called from DECLARE TARGET procedure '%s' here"_en_US,
+              callee->name(), edge.caller->name());
+          break;
+        }
+        message.Attach(edge.source, "'%s' is called from '%s' here"_en_US,
+            callee->name(), edge.caller->name());
+        callee = edge.caller;
+      }
+    }
+    worklist.insert(worklist.end(), info.calls.begin(), info.calls.end());
+  }
+}
+
+} // namespace Fortran::semantics
diff --git a/flang/lib/Semantics/check-omp-device.h b/flang/lib/Semantics/check-omp-device.h
new file mode 100644
index 00000000000000..4e8b00ebc07bda
--- /dev/null
+++ b/flang/lib/Semantics/check-omp-device.h
@@ -0,0 +1,140 @@
+//===-- lib/Semantics/check-omp-device.h ------------------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+// Semantic checks of OpenMP target device code, i.e. the bodies of TARGET
+// constructs and procedures that are explicitly or implicitly DECLARE TARGET.
+
+#ifndef FORTRAN_SEMANTICS_CHECK_OMP_DEVICE_H_
+#define FORTRAN_SEMANTICS_CHECK_OMP_DEVICE_H_
+
+#include "flang/Parser/parse-tree.h"
+#include "flang/Semantics/semantics.h"
+#include "llvm/ADT/DenseMap.h"
+#include "llvm/ADT/SmallPtrSet.h"
+#include "llvm/Frontend/OpenMP/OMP.h"
+#include <vector>
+
+namespace Fortran::semantics {
+
+// Checks that no THREADPRIVATE variable is accessed in target device code.
+//
+// Accesses in the body of a TARGET construct and in the execution part of a
+// procedure that is explicitly DECLARE TARGET for the device are diagnosed
+// immediately. A procedure that is called from device code becomes implicitly
+// DECLARE TARGET, which is only known once the whole compilation unit has been
+// seen. Accesses and calls of all other procedures are therefore recorded, and
+// those reachable from device code are diagnosed at the end of the compilation
+// unit when compiling for a target device.
+class OmpDeviceChecker : public virtual BaseChecker {
+public:
+  explicit OmpDeviceChecker(SemanticsContext &);
+
+  void Leave(const parser::Program &);
+  void Enter(const parser::SubroutineSubprogram &);
+  void Leave(const parser::SubroutineSubprogram &);
+  void Enter(const parser::FunctionSubprogram &);
+  void Leave(const parser::FunctionSubprogram &);
+  void Enter(const parser::SeparateModuleSubprogram &);
+  void Leave(const parser::SeparateModuleSubprogram &);
+  void Enter(const parser::ExecutionPart &);
+  void Leave(const parser::ExecutionPart &);
+  void Enter(const parser::EntryStmt &);
+
+  void Leave(const parser::OmpBeginDirective &);
+  void Leave(const parser::OmpBlockConstruct &);
+  void Leave(const parser::OpenMPLoopConstruct &);
+  void Enter(const parser::OmpClause &);
+  void Leave(const parser::OmpClause &);
+  void Enter(const parser::OmpObjectList &);
+  void Leave(const parser::OmpObjectList &);
+  void Enter(const parser::OmpArgumentList &);
+  void Leave(const parser::OmpArgumentList &);
+  void Enter(const parser::DataStmt &);
+  void Leave(const parser::DataStmt &);
+
+  void Enter(const parser::Name &);
+  void Enter(const parser::Expr &);
+  void Leave(const parser::Expr &);
+  void Enter(const parser::CallStmt &);
+  void Enter(const parser::AssignmentStmt &);
+
+private:
+  enum class DeviceContext { None, TargetRegion, DeclareTarget };
+
+  // An access to a THREADPRIVATE variable, possibly through a statement
+  // function.
+  struct Access {
+    parser::CharBlock source;
+    const Symbol *variable;
+    const Symbol *statementFunction;
+  };
+
+  // A call of a procedure. `caller` is the procedure containing the call
+  // (null in a main program). `context` is the device context of the call.
+  struct Call {
+    parser::CharBlock source;
+    const Symbol *callee;
+    const Symbol *caller;
+    DeviceContext context;
+  };
+
+  struct ProcedureInfo {
+    // Whether the procedure is explicitly DECLARE TARGET, and whether that
+    // makes it device code (i.e. DEVICE_TYPE is not HOST).
+    bool isExplicitDeclareTarget{false};
+    bool isExplicitDevice{false};
+    std::vector<Access> accesses;
+    std::vector<Call> calls;
+  };
+
+  void EnterProcedure(const Symbol *);
+  void LeaveProcedure();
+  void LeaveConstruct(const parser::OmpBeginDirective &);
+  DeviceContext GetDeviceContext() const;
+  const Symbol *CurrentProcedure() const;
+
+  void CheckReference(parser::CharBlock, const Symbol &,
+      const Symbol *statementFunction = nullptr);
+  void CheckAccess(const Access &);
+  void RecordCall(parser::CharBlock, const Symbol &);
+  void RecordCalls(parser::CharBlock, const SomeExpr &);
+
+  const Symbol *FindDefinition(const Symbol &) const;
+  void CheckImplicitDeclareTarget();
+
+  SemanticsContext &context_;
+  // Whether implicit DECLARE TARGET procedures need to be checked.
+  bool isTargetDevice_;
+  // Procedures whose definitions are being walked (innermost last).
+  std::vector<const Symbol *> procedures_;
+  // Begin directives of the enclosing TARGET constructs whose body is being
+  // walked.
+  std::vector<const parser::OmpBeginDirective *> targets_;
+  // Clauses being walked (innermost last).
+  std::vector<llvm::omp::Clause> clauses_;
+  // For each object list being walked, whether its objects are skipped.
+  std::vector<bool> skippedObjectLists_;
+  bool inExecutionPart_{false};
+  // Number of enclosing parse tree nodes whose names are not checked.
+  int skipDepth_{0};
+  // Number of enclosing parser::Expr nodes.
+  int exprDepth_{0};
+  // Statement functions being expanded, to avoid infinite recursion.
+  llvm::SmallPtrSet<const Symbol *, 4> expanding_;
+
+  // All procedures defined in the compilation unit.
+  llvm::DenseMap<const Symbol *, ProcedureInfo> procedureInfo_;
+  // Symbols that refer to a procedure definition in the compilation unit:
+  // ENTRY names and interfaces of separate module procedures.
+  llvm::DenseMap<const Symbol *, const Symbol *> aliases_;
+  // Calls from device code.
+  std::vector<Call> deviceCalls_;
+};
+
+} // namespace Fortran::semantics
+#endif // FORTRAN_SEMANTICS_CHECK_OMP_DEVICE_H_
diff --git a/flang/lib/Semantics/semantics.cpp b/flang/lib/Semantics/semantics.cpp
index 224f5bcb1c18ab..fcd143e4b07e2a 100644
--- a/flang/lib/Semantics/semantics.cpp
+++ b/flang/lib/Semantics/semantics.cpp
@@ -26,6 +26,7 @@
 #include "check-io.h"
 #include "check-namelist.h"
 #include "check-nullify.h"
+#include "check-omp-device.h"
 #include "check-omp-structure.h"
 #include "check-purity.h"
 #include "check-return.h"
@@ -256,6 +257,7 @@ static bool PerformStatementSemantics(
   }
   if (context.languageFeatures().IsEnabled(common::LanguageFeature::OpenMP)) {
     SemanticsVisitor<OmpStructureChecker>{context}.Walk(program);
+    SemanticsVisitor<OmpDeviceChecker>{context}.Walk(program);
   }
   if (context.languageFeatures().IsEnabled(common::LanguageFeature::CUDA)) {
     SemanticsVisitor<CUDAChecker>{context}.Walk(program);
diff --git a/flang/test/Fir/basic-program.fir b/flang/test/Fir/basic-program.fir
index 51f4699bde7bf9..06a7ccb09ba74b 100644
--- a/flang/test/Fir/basic-program.fir
+++ b/flang/test/Fir/basic-program.fir
@@ -188,6 +188,7 @@ func.func @_QQmain() {
 // PASSES-NEXT:  FunctionAttr
 // PASSES-NEXT:  LowerNontemporalPass
 // PASSES-NEXT: MarkDeclareTargetPass
+// PASSES-NEXT: DeviceThreadprivateCheckPass
 // PASSES-NEXT: UnimplementedDeviceCheckPass
 // PASSES-NEXT: FIRToLLVMLowering
 // PASSES-NEXT: ReconcileUnrealizedCasts
diff --git a/flang/test/Integration/OpenMP/threadprivate-target-device.f90 b/flang/test/Integration/OpenMP/threadprivate-target-device.f90
index 563cac697aa257..e108abc412afbb 100644
--- a/flang/test/Integration/OpenMP/threadprivate-target-device.f90
+++ b/flang/test/Integration/OpenMP/threadprivate-target-device.f90
@@ -11,17 +11,16 @@
 
 ! The aim of this test is to verify host threadprivate directives do not cause
 ! crashes during OpenMP target device codegen when used in conjunction with
-! target code in the same function.
-
-! CHECK: define weak_odr protected amdgpu_kernel void @{{.*}}(ptr %[[ARG1:.*]], ptr %[[ARG2:.*]], ptr %{{.*}}) #{{[0-9]+}} {
-! CHECK:  %[[ALLOC_N:.*]] = call align 8 ptr @__kmpc_alloc_shared(i64 8)
-! CHECK:  store ptr %[[ARG2]], ptr %[[ALLOC_N]], align 8
+! target code in the same function. The threadprivate variable is only
+! referenced on the host (in the map clause), since accessing it inside the
+! target region is rejected by semantics.
 
+! CHECK: define weak_odr protected amdgpu_kernel void @{{.*}}(ptr %[[ARG1:.*]], ptr %{{.*}}, ptr %{{.*}}) #{{[0-9]+}} {
 ! CHECK:  %[[ALLOC_X:.*]] = call align 8 ptr @__kmpc_alloc_shared(i64 8)
 ! CHECK:  store ptr %[[ARG1]], ptr %[[ALLOC_X]], align 8
 
 ! CHECK:  %[[LOAD_X:.*]] = load ptr, ptr %[[ALLOC_X]], align 8
-! CHECK:  call void @bar_(ptr %[[LOAD_X]], ptr %[[ALLOC_N]])
+! CHECK:  call void @bar_(ptr %[[LOAD_X]])
 
 module test
   implicit none
@@ -32,7 +31,7 @@ module test
   subroutine foo(x)
     integer, intent(inout) :: x(10)
     !$omp target map(tofrom: x(1:n))
-      call bar(x, n)
+      call bar(x)
     !$omp end target
   end subroutine
 end module
diff --git a/flang/test/Integration/OpenMP/threadprivate-unused-in-target-device.f90 b/flang/test/Integration/OpenMP/threadprivate-unused-in-target-device.f90
new file mode 100644
index 00000000000000..03d2ff27cdec72
--- /dev/null
+++ b/flang/test/Integration/OpenMP/threadprivate-unused-in-target-device.f90
@@ -0,0 +1,45 @@
+!===----------------------------------------------------------------------===!
+! This directory can be used to add Integration tests involving multiple
+! stages of the compiler (for eg. from Fortran to LLVM IR). It should not
+! contain executable tests. We should only add tests here sparingly and only
+! if there is no other way to test. Repeat this message in each test that is
+! added to this directory and sub-directories.
+!===----------------------------------------------------------------------===!
+
+!REQUIRES: amdgpu-registered-target
+!RUN: %flang_fc1 -triple amdgcn-amd-amdhsa -emit-llvm -fopenmp -fopenmp-is-target-device %s -o - | FileCheck %s
+
+! A procedure called from a target region may declare or use threadprivate
+! variables, as long as it does not access them. Check that it can be compiled
+! for the device.
+
+! CHECK-NOT: __kmpc_threadprivate_cached
+! CHECK: define {{.*}} @work_(
+! CHECK-NOT: __kmpc_threadprivate_cached
+
+module m
+  integer :: mv
+  !$omp threadprivate(mv)
+end module
+
+subroutine work(i)
+  use m
+  integer :: i
+  integer, save :: y
+  integer :: x
+  common /c/ x
+  !$omp threadprivate(/c/, y)
+  i = i + 1
+end subroutine
+
+subroutine s(n)
+  integer :: n
+  interface
+    subroutine work(i)
+      integer :: i
+    end subroutine
+  end interface
+  !$omp target
+  call work(n)
+  !$omp end target
+end subroutine
diff --git a/flang/test/Lower/OpenMP/threadprivate-distribute-parallel-do.f90 b/flang/test/Lower/OpenMP/threadprivate-distribute-parallel-do.f90
new file mode 100644
index 00000000000000..5d4819c70efb3d
--- /dev/null
+++ b/flang/test/Lower/OpenMP/threadprivate-distribute-parallel-do.f90
@@ -0,0 +1,48 @@
+! Check that threadprivate variables referenced in a composite DISTRIBUTE
+! PARALLEL DO construct are bound inside the loop nest, since a composite
+! omp.parallel may only contain its omp.distribute.
+
+!RUN: %flang_fc1 -emit-hlfir -fopenmp %s -o - | FileCheck %s
+
+!CHECK-LABEL: func.func @_QPdpd
+!CHECK:         %[[CMN:.*]] = fir.address_of(@c_) : !fir.ref<!fir.array<4xi8>>
+!CHECK:         omp.teams
+!CHECK-NEXT:      omp.parallel
+!CHECK-NOT:         omp.threadprivate
+!CHECK:            omp.distribute
+!CHECK-NEXT:          omp.wsloop
+!CHECK-NEXT:            omp.loop_nest
+!CHECK:                   omp.threadprivate %[[CMN]] : !fir.ref<!fir.array<4xi8>> -> !fir.ref<!fir.array<4xi8>>
+subroutine dpd(n)
+  integer :: n, i
+  integer :: x
+  common /c/ x
+  !$omp threadprivate(/c/)
+
+  !$omp teams distribute parallel do
+  do i = 1, n
+    x = i
+  end do
+end subroutine
+
+!CHECK-LABEL: func.func @_QPdpd_simd
+!CHECK:         %[[CMN:.*]] = fir.address_of(@c_) : !fir.ref<!fir.array<4xi8>>
+!CHECK:         omp.teams
+!CHECK-NEXT:      omp.parallel
+!CHECK-NOT:         omp.threadprivate
+!CHECK:            omp.distribute
+!CHECK-NEXT:          omp.wsloop
+!CHECK-NEXT:            omp.simd
+!CHECK-NEXT:              omp.loop_nest
+!CHECK:                     omp.threadprivate %[[CMN]] : !fir.ref<!fir.array<4xi8>> -> !fir.ref<!fir.array<4xi8>>
+subroutine dpd_simd(n)
+  integer :: n, i
+  integer :: x
+  common /c/ x
+  !$omp threadprivate(/c/)
+
+  !$omp teams distribute parallel do simd
+  do i = 1, n
+    x = i
+  end do
+end subroutine
\ No newline at end of file
diff --git a/flang/test/Semantics/OpenMP/threadprivate-target-implicit.f90 b/flang/test/Semantics/OpenMP/threadprivate-target-implicit.f90
new file mode 100644
index 00000000000000..3adcccadc1d4f4
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/threadprivate-target-implicit.f90
@@ -0,0 +1,124 @@
+! RUN: %python %S/../test_errors.py %s %flang_fc1 -fopenmp -fopenmp-version=52 -fopenmp-is-target-device
+! RUN: %flang_fc1 -fopenmp -fopenmp-version=52 -fsyntax-only %s
+!
+! A procedure that is called from device code is implicitly DECLARE TARGET.
+! Accesses to THREADPRIVATE variables in such procedures are diagnosed when
+! compiling for the target device only.
+
+module m
+  integer :: mv, unused_mv
+  !$omp threadprivate(mv, unused_mv)
+
+  type :: t
+    integer :: v
+  contains
+    procedure :: bound
+  end type
+
+  interface generic
+    module procedure specific
+  end interface
+
+  interface assignment(=)
+    module procedure assign
+  end interface
+
+contains
+  subroutine bound(this)
+    class(t), intent(inout) :: this
+    !ERROR: A THREADPRIVATE variable 'mv' cannot be accessed in procedure 'bound', which is implicitly DECLARE TARGET
+    this%v = mv
+  end subroutine
+
+  subroutine specific(i)
+    integer, intent(inout) :: i
+    !ERROR: A THREADPRIVATE variable 'mv' cannot be accessed in procedure 'specific', which is implicitly DECLARE TARGET
+    i = mv
+  end subroutine
+
+  subroutine assign(a, i)
+    type(t), intent(out) :: a
+    integer, intent(in) :: i
+    !ERROR: A THREADPRIVATE variable 'mv' cannot be accessed in procedure 'assign', which is implicitly DECLARE TARGET
+    a%v = i + mv
+  end subroutine
+
+  integer function func(i)
+    integer, intent(in) :: i
+    !ERROR: A THREADPRIVATE variable 'mv' cannot be accessed in procedure 'func', which is implicitly DECLARE TARGET
+    func = i + mv
+  end function
+
+  ! Only uses the module, which declares THREADPRIVATE variables.
+  subroutine no_access(i)
+    integer, intent(inout) :: i
+    i = i + 1
+  end subroutine
+
+  ! Only called from the host.
+  subroutine host_only(i)
+    integer, intent(inout) :: i
+    i = mv
+  end subroutine
+
+  ! Explicitly DECLARE TARGET for the host only.
+  subroutine explicit_host(i)
+    integer, intent(inout) :: i
+    !$omp declare target enter(explicit_host) device_type(host)
+    i = mv
+  end subroutine
+end module
+
+! An intermediate procedure that does not access THREADPRIVATE variables.
+subroutine middle(i)
+  integer, intent(inout) :: i
+  call leaf(i)
+end subroutine
+
+! Defined after its use.
+subroutine leaf(i)
+  integer, intent(inout) :: i
+  integer, save :: sv
+  integer :: x
+  common /c/ x
+  !$omp threadprivate(sv, /c/)
+  !ERROR: A THREADPRIVATE variable 'sv' cannot be accessed in procedure 'leaf', which is implicitly DECLARE TARGET
+  i = sv
+  !ERROR: A THREADPRIVATE variable 'x' cannot be accessed in procedure 'leaf', which is implicitly DECLARE TARGET
+  x = i
+end subroutine
+
+subroutine explicit_device(i)
+  integer, intent(inout) :: i
+  !$omp declare target
+  call internal(i)
+contains
+  ! Called from a DECLARE TARGET procedure.
+  subroutine internal(i)
+    use m
+    integer, intent(inout) :: i
+    !ERROR: A THREADPRIVATE variable 'mv' cannot be accessed in procedure 'internal', which is implicitly DECLARE TARGET
+    i = mv
+  end subroutine
+end subroutine
+
+subroutine s(n)
+  use m
+  integer :: n
+  type(t) :: obj
+  interface
+    subroutine middle(i)
+      integer, intent(inout) :: i
+    end subroutine
+  end interface
+  call host_only(n)
+  !$omp target map(tofrom: n, obj)
+  call middle(n)
+  call generic(n)
+  call obj%bound()
+  obj = n
+  n = func(n)
+  call no_access(n)
+  call explicit_host(n)
+  !$omp end target
+end subroutine
diff --git a/flang/test/Semantics/OpenMP/threadprivate-target.f90 b/flang/test/Semantics/OpenMP/threadprivate-target.f90
new file mode 100644
index 00000000000000..594e0619966c49
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/threadprivate-target.f90
@@ -0,0 +1,157 @@
+! RUN: %python %S/../test_errors.py %s %flang_fc1 -fopenmp -fopenmp-version=52
+!
+! OpenMP 5.2: 5.2 threadprivate directive restriction
+! The effect of an access to a threadprivate variable in a target region is
+! unspecified.
+
+module m
+  integer :: mv
+  !$omp threadprivate(mv)
+end module
+
+subroutine target_regions(n)
+  use m
+  integer :: n, i, j
+  integer, save :: sv
+  real :: x, y(100)
+  common /c/ x, y
+  !$omp threadprivate(sv, /c/)
+
+  !$omp target
+  !ERROR: A THREADPRIVATE variable 'x' cannot be accessed in a TARGET region
+  x = 1.0
+  !$omp end target
+
+  !$omp target teams
+  !ERROR: A THREADPRIVATE variable 'sv' cannot be accessed in a TARGET region
+  sv = 1
+  !$omp end target teams
+
+  !$omp target parallel do
+  do i = 1, n
+    !ERROR: A THREADPRIVATE variable 'y' cannot be accessed in a TARGET region
+    y(i) = i
+  end do
+
+  !$omp target teams distribute parallel do
+  do i = 1, n
+    !ERROR: A THREADPRIVATE variable 'x' cannot be accessed in a TARGET region
+    x = i
+  end do
+
+  !$omp target teams distribute parallel do simd
+  do i = 1, n
+    !ERROR: A THREADPRIVATE variable 'mv' cannot be accessed in a TARGET region
+    mv = i
+  end do
+
+  !$omp target teams distribute
+  do i = 1, n
+    !$omp parallel do
+    do j = 1, 10
+      !ERROR: A THREADPRIVATE variable 'y' cannot be accessed in a TARGET region
+      !ERROR: A THREADPRIVATE variable 'x' cannot be accessed in a TARGET region
+      y(j) = x
+    end do
+  end do
+
+  ! Clause expressions of the TARGET construct itself are evaluated on the host.
+  !$omp target if(sv > 0)
+  !$omp end target
+end subroutine
+
+subroutine declare_target_proc(n)
+  integer :: n, i
+  real :: x
+  common /c/ x
+  !$omp threadprivate(/c/)
+  !$omp declare target
+  !ERROR: A THREADPRIVATE variable 'x' cannot be accessed in a DECLARE TARGET procedure
+  x = n
+  ! Diagnosed once, for the innermost device context.
+  !$omp target
+  !ERROR: A THREADPRIVATE variable 'x' cannot be accessed in a TARGET region
+  x = 1.0
+  !$omp end target
+contains
+  subroutine internal()
+    ! Internal procedures are only implicitly DECLARE TARGET, which is checked
+    ! only when compiling for the device (threadprivate-target-implicit.f90).
+    x = 2.0
+  end subroutine
+end subroutine
+
+subroutine declare_target_host(n)
+  integer :: n
+  integer, save :: sv
+  !$omp threadprivate(sv)
+  !$omp declare target enter(declare_target_host) device_type(host)
+  sv = n
+end subroutine
+
+subroutine declare_target_unused(n)
+  use m
+  integer :: n
+  integer, save :: sv
+  !$omp threadprivate(sv)
+  !$omp declare target
+  n = n + 1
+end subroutine
+
+subroutine indirect_accesses(n, m)
+  integer :: n, m, i
+  integer, save :: tp
+  integer :: f, g
+  real :: x
+  common /c/ x
+  !$omp threadprivate(tp, /c/)
+  f(i) = i + tp
+  g(i) = f(i) + 1
+  !$omp target
+  ! Through a statement function, also a nested one.
+  !ERROR: A THREADPRIVATE variable 'tp' cannot be accessed in a TARGET region
+  n = f(1)
+  !ERROR: A THREADPRIVATE variable 'tp' cannot be accessed in a TARGET region
+  m = g(1)
+  ! In a clause that allows THREADPRIVATE variables.
+  !ERROR: A THREADPRIVATE variable 'tp' cannot be accessed in a TARGET region
+  !ERROR: A THREADPRIVATE variable '/c/' cannot be accessed in a TARGET region
+  !$omp parallel copyin(tp, /c/)
+  !$omp end parallel
+  ! In a clause expression of a nested construct.
+  !ERROR: A THREADPRIVATE variable 'tp' cannot be accessed in a TARGET region
+  !$omp parallel if(tp > 0)
+  !$omp end parallel
+  !$omp end target
+  ! Through ASSOCIATE names.
+  associate (a => tp, b => x)
+  !$omp target
+  !ERROR: A THREADPRIVATE variable 'tp' cannot be accessed in a TARGET region
+  !ERROR: A THREADPRIVATE variable 'x' cannot be accessed in a TARGET region
+  n = a + b
+  !$omp end target
+  end associate
+  ! As DO variable.
+  !$omp target
+  !ERROR: A THREADPRIVATE variable 'tp' cannot be accessed in a TARGET region
+  do tp = 1, n
+  end do
+  !$omp end target
+end subroutine
+
+subroutine host_regions(n)
+  integer :: n, i
+  real :: x
+  common /c/ x
+  !$omp threadprivate(/c/)
+
+  !$omp parallel do
+  do i = 1, n
+    x = i
+  end do
+
+  !$omp teams distribute parallel do
+  do i = 1, n
+    x = i
+  end do
+end subroutine
\ No newline at end of file
diff --git a/flang/test/Transforms/omp-device-threadprivate-check.fir b/flang/test/Transforms/omp-device-threadprivate-check.fir
new file mode 100644
index 00000000000000..76252f51b3f5a7
--- /dev/null
+++ b/flang/test/Transforms/omp-device-threadprivate-check.fir
@@ -0,0 +1,96 @@
+// RUN: fir-opt --omp-device-threadprivate-check -split-input-file -verify-diagnostics %s | FileCheck %s
+
+// Accesses to threadprivate variables in device code are diagnosed.
+
+module attributes {omp.is_gpu = true, omp.is_target_device = true} {
+  // expected-note @below {{declared here}}
+  fir.global common @c_(dense<0> : vector<4xi8>) {alignment = 4 : i64} : !fir.array<4xi8>
+  // expected-note @below {{declared here}}
+  fir.global internal @_QFsave_varEy : i32
+
+  func.func @common_member(%arg0: !fir.ref<i32>) attributes {omp.declare_target = #omp.declaretarget<device_type = any, capture_clause = to, implicit = true>} {
+    %c0 = arith.constant 0 : index
+    %0 = fir.address_of(@c_) : !fir.ref<!fir.array<4xi8>>
+    %1 = omp.threadprivate %0 : !fir.ref<!fir.array<4xi8>> -> !fir.ref<!fir.array<4xi8>>
+    %2 = fir.coordinate_of %1, %c0 : (!fir.ref<!fir.array<4xi8>>, index) -> !fir.ref<i8>
+    %3 = fir.convert %2 : (!fir.ref<i8>) -> !fir.ref<i32>
+    %4 = fir.load %arg0 : !fir.ref<i32>
+    // expected-error @below {{THREADPRIVATE common block '/c/' cannot be accessed in target device code}}
+    fir.store %4 to %3 : !fir.ref<i32>
+    return
+  }
+
+  func.func @save_var(%arg0: !fir.ref<i32>) attributes {omp.declare_target = #omp.declaretarget<device_type = nohost, capture_clause = to, implicit = true>} {
+    %0 = fir.address_of(@_QFsave_varEy) : !fir.ref<i32>
+    %1 = omp.threadprivate %0 : !fir.ref<i32> -> !fir.ref<i32>
+    // expected-error @below {{THREADPRIVATE variable 'y' cannot be accessed in target device code}}
+    %2 = fir.load %1 : !fir.ref<i32>
+    fir.store %2 to %arg0 : !fir.ref<i32>
+    return
+  }
+}
+
+// -----
+
+// Threadprivate operations of variables that are not accessed in device code
+// are removed. Host code is not modified.
+
+module attributes {omp.is_gpu = true, omp.is_target_device = true} {
+  fir.global common @c_(dense<0> : vector<4xi8>) {alignment = 4 : i64} : !fir.array<4xi8>
+  fir.global @_QMmEmv : i32
+
+  // CHECK-LABEL: func.func @unused
+  // CHECK-NOT:     omp.threadprivate
+  // CHECK-NOT:     fir.coordinate_of
+  // CHECK-NOT:     fir.declare
+  // CHECK:         return
+  func.func @unused() attributes {omp.declare_target = #omp.declaretarget<device_type = any, capture_clause = to, implicit = true>} {
+    %c0 = arith.constant 0 : index
+    %0 = fir.address_of(@c_) : !fir.ref<!fir.array<4xi8>>
+    %1 = omp.threadprivate %0 : !fir.ref<!fir.array<4xi8>> -> !fir.ref<!fir.array<4xi8>>
+    %2 = fir.coordinate_of %1, %c0 : (!fir.ref<!fir.array<4xi8>>, index) -> !fir.ref<i8>
+    %3 = fir.convert %2 : (!fir.ref<i8>) -> !fir.ref<i32>
+    %4 = fir.declare %3 storage(%1[0]) uniq_name("_QFunusedEx") : (!fir.ref<i32>, !fir.ref<!fir.array<4xi8>>) -> !fir.ref<i32>
+    %5 = fir.address_of(@_QMmEmv) : !fir.ref<i32>
+    %6 = omp.threadprivate %5 : !fir.ref<i32> -> !fir.ref<i32>
+    return
+  }
+
+  // CHECK-LABEL: func.func @host_only
+  // CHECK:         omp.threadprivate
+  func.func @host_only(%arg0: !fir.ref<i32>) {
+    %0 = fir.address_of(@_QMmEmv) : !fir.ref<i32>
+    %1 = omp.threadprivate %0 : !fir.ref<i32> -> !fir.ref<i32>
+    %2 = fir.load %1 : !fir.ref<i32>
+    fir.store %2 to %arg0 : !fir.ref<i32>
+    return
+  }
+
+  // CHECK-LABEL: func.func @device_type_host
+  // CHECK:         omp.threadprivate
+  func.func @device_type_host(%arg0: !fir.ref<i32>) attributes {omp.declare_target = #omp.declaretarget<device_type = host, capture_clause = to>} {
+    %0 = fir.address_of(@_QMmEmv) : !fir.ref<i32>
+    %1 = omp.threadprivate %0 : !fir.ref<i32> -> !fir.ref<i32>
+    %2 = fir.load %1 : !fir.ref<i32>
+    fir.store %2 to %arg0 : !fir.ref<i32>
+    return
+  }
+}
+
+// -----
+
+// Nothing is done when compiling for the host.
+
+module attributes {omp.is_target_device = false} {
+  fir.global @_QMmEmv : i32
+
+  // CHECK-LABEL: func.func @host_module
+  // CHECK:         omp.threadprivate
+  func.func @host_module(%arg0: !fir.ref<i32>) attributes {omp.declare_target = #omp.declaretarget<device_type = any, capture_clause = to, implicit = true>} {
+    %0 = fir.address_of(@_QMmEmv) : !fir.ref<i32>
+    %1 = omp.threadprivate %0 : !fir.ref<i32> -> !fir.ref<i32>
+    %2 = fir.load %1 : !fir.ref<i32>
+    fir.store %2 to %arg0 : !fir.ref<i32>
+    return
+  }
+}
diff --git a/mlir/lib/Target/LLVMIR/Dialect/OpenMP/OpenMPToLLVMIRTranslation.cpp b/mlir/lib/Target/LLVMIR/Dialect/OpenMP/OpenMPToLLVMIRTranslation.cpp
index e8bcc22464439b..d49aa34b686ab8 100644
--- a/mlir/lib/Target/LLVMIR/Dialect/OpenMP/OpenMPToLLVMIRTranslation.cpp
+++ b/mlir/lib/Target/LLVMIR/Dialect/OpenMP/OpenMPToLLVMIRTranslation.cpp
@@ -7045,6 +7045,15 @@ convertOmpThreadprivate(Operation &opInst, llvm::IRBuilderBase &builder,
     return opInst.emitError("Addressing symbol not found");
   LLVM::AddressOfOp addressOfOp = dyn_cast<LLVM::AddressOfOp>(symOp);
 
+  // Threadprivate variables are host thread-local storage, which the device
+  // runtime does not provide. Host-only code never reaches this point when
+  // compiling for the device, so this is an access from device code (e.g. a
+  // procedure called from a target region).
+  if (ompBuilder->Config.isTargetDevice())
+    return opInst.emitError()
+           << "threadprivate variable '" << addressOfOp.getGlobalName()
+           << "' cannot be accessed in device code";
+
   LLVM::GlobalOp global =
       addressOfOp.getGlobal(moduleTranslation.symbolTable());
   llvm::GlobalValue *globalValue = moduleTranslation.lookupGlobal(global);
diff --git a/mlir/test/Target/LLVMIR/openmp-llvm-invalid.mlir b/mlir/test/Target/LLVMIR/openmp-llvm-invalid.mlir
index 89b0a3cc069e8b..08a6886905fd4f 100644
--- a/mlir/test/Target/LLVMIR/openmp-llvm-invalid.mlir
+++ b/mlir/test/Target/LLVMIR/openmp-llvm-invalid.mlir
@@ -164,6 +164,19 @@ module attributes {llvm.target_triple = "amdgcn-amd-amdhsa", omp.is_target_devic
 
 // -----
 
+module attributes {llvm.target_triple = "amdgcn-amd-amdhsa", omp.is_target_device = true} {
+  llvm.mlir.global internal @tp_var() : i32
+  llvm.func @threadprivate_in_declare_target() attributes {omp.declare_target = #omp.declaretarget<device_type = any, capture_clause = to>} {
+    %0 = llvm.mlir.addressof @tp_var : !llvm.ptr
+    // expected-error @below {{threadprivate variable 'tp_var' cannot be accessed in device code}}
+    // expected-error @below {{LLVM Translation failed for operation: omp.threadprivate}}
+    %1 = omp.threadprivate %0 : !llvm.ptr -> !llvm.ptr
+    llvm.return
+  }
+}
+
+// -----
+
 module attributes {llvm.target_triple = "amdgcn-amd-amdhsa", omp.is_target_device = true} {
   llvm.func @host_op_in_device_nested_target(%arg0 : !llvm.ptr) {
     // expected-error @below {{unsupported host op found in device}}



More information about the Mlir-commits mailing list