diff --git a/flang/lib/Lower/HostAssociations.cpp b/flang/lib/Lower/HostAssociations.cpp index b9e13ccad1c92..414673b00f44c 100644 --- a/flang/lib/Lower/HostAssociations.cpp +++ b/flang/lib/Lower/HostAssociations.cpp @@ -14,6 +14,7 @@ #include "flang/Lower/CallInterface.h" #include "flang/Lower/ConvertType.h" #include "flang/Lower/ConvertVariable.h" +#include "flang/Lower/OpenMP.h" #include "flang/Lower/PFTBuilder.h" #include "flang/Lower/SymbolMap.h" #include "flang/Optimizer/Builder/Character.h" @@ -542,7 +543,10 @@ void Fortran::lower::HostAssociations::addSymbolsToBind( "must be initially empty"); this->hostScope = &hostScope; for (const auto *s : symbols) - if (Fortran::lower::symbolIsGlobal(*s)) { + // GlobalOp are created for non-global threadprivate variable, + // so considering them as globals. + if (Fortran::lower::symbolIsGlobal(*s) || + (*s).test(Fortran::semantics::Symbol::Flag::OmpThreadprivate)) { // The ultimate symbol is stored here so that global symbols from the // host scope can later be searched in this set. globalSymbols.insert(&s->GetUltimate()); @@ -590,9 +594,15 @@ void Fortran::lower::HostAssociations::internalProcedureBindings( for (auto &hostVariable : pft::getScopeVariableList(*hostScope)) if ((hostVariable.isAggregateStore() && hostVariable.isGlobal()) || (hostVariable.hasSymbol() && - globalSymbols.contains(&hostVariable.getSymbol().GetUltimate()))) + globalSymbols.contains(&hostVariable.getSymbol().GetUltimate()))) { Fortran::lower::instantiateVariable(converter, hostVariable, symMap, storeMap); + // Generate threadprivate Op for host associated variables. + if (hostVariable.hasSymbol() && + hostVariable.getSymbol().test( + Fortran::semantics::Symbol::Flag::OmpThreadprivate)) + Fortran::lower::genThreadprivateOp(converter, hostVariable); + } } if (tupleSymbols.empty()) return; diff --git a/flang/lib/Lower/OpenMP/OpenMP.cpp b/flang/lib/Lower/OpenMP/OpenMP.cpp index 5cff95c7d125b..4f0bb80cd7fdf 100644 --- a/flang/lib/Lower/OpenMP/OpenMP.cpp +++ b/flang/lib/Lower/OpenMP/OpenMP.cpp @@ -170,9 +170,10 @@ static void threadPrivatizeVars(Fortran::lower::AbstractConverter &converter, }; llvm::SetVector threadprivateSyms; - converter.collectSymbolSet( - eval, threadprivateSyms, - Fortran::semantics::Symbol::Flag::OmpThreadprivate); + converter.collectSymbolSet(eval, threadprivateSyms, + Fortran::semantics::Symbol::Flag::OmpThreadprivate, + /*collectSymbols=*/true, + /*collectHostAssociatedSymbols=*/true); std::set threadprivateSymNames; // For a COMMON block, the ThreadprivateOp is generated for itself instead of @@ -2276,8 +2277,15 @@ void Fortran::lower::genThreadprivateOp( // variable in main program, and it has implicit SAVE attribute. Take it as // with SAVE attribute, so to create GlobalOp for it to simplify the // translation to LLVM IR. - fir::GlobalOp global = globalInitialization(converter, firOpBuilder, sym, - var, currentLocation); + // Avoids performing multiple globalInitializations. + fir::GlobalOp global; + auto module = converter.getModuleOp(); + std::string globalName = converter.mangleName(sym); + if (module.lookupSymbol(globalName)) + global = module.lookupSymbol(globalName); + else + global = globalInitialization(converter, firOpBuilder, sym, var, + currentLocation); mlir::Value symValue = firOpBuilder.create( currentLocation, global.resultType(), global.getSymbol()); diff --git a/flang/test/Lower/OpenMP/threadprivate-host-association-2.f90 b/flang/test/Lower/OpenMP/threadprivate-host-association-2.f90 new file mode 100644 index 0000000000000..b47bff5bebb0b --- /dev/null +++ b/flang/test/Lower/OpenMP/threadprivate-host-association-2.f90 @@ -0,0 +1,44 @@ +! This test checks lowering of OpenMP Threadprivate Directive. +! Test for threadprivate variable in host association. + +!RUN: %flang_fc1 -emit-hlfir -fopenmp %s -o - | FileCheck %s + +!CHECK: func.func @_QQmain() attributes {fir.bindc_name = "main"} { +!CHECK: %[[A:.*]] = fir.alloca i32 {bindc_name = "a", uniq_name = "_QFEa"} +!CHECK: %[[A_DECL:.*]]:2 = hlfir.declare %[[A]] {uniq_name = "_QFEa"} : (!fir.ref) -> (!fir.ref, !fir.ref) +!CHECK: %[[A_ADDR:.*]] = fir.address_of(@_QFEa) : !fir.ref +!CHECK: %[[TP_A:.*]] = omp.threadprivate %[[A_ADDR]] : !fir.ref -> !fir.ref +!CHECK: %[[TP_A_DECL:.*]]:2 = hlfir.declare %[[TP_A]] {uniq_name = "_QFEa"} : (!fir.ref) -> (!fir.ref, !fir.ref) +!CHECK: fir.call @_QFPsub() fastmath : () -> () +!CHECK: return +!CHECK: } +!CHECK: func.func private @_QFPsub() attributes {fir.internal_proc, llvm.linkage = #llvm.linkage} { +!CHECK: %[[A:.*]] = fir.alloca i32 {bindc_name = "a", uniq_name = "_QFEa"} +!CHECK: %[[A_DECL:.*]]:2 = hlfir.declare %[[A]] {uniq_name = "_QFEa"} : (!fir.ref) -> (!fir.ref, !fir.ref) +!CHECK: %[[A_ADDR:.*]] = fir.address_of(@_QFEa) : !fir.ref +!CHECK: %[[TP_A:.*]] = omp.threadprivate %[[A_ADDR]] : !fir.ref -> !fir.ref +!CHECK: %[[TP_A_DECL:.*]]:2 = hlfir.declare %[[TP_A]] {uniq_name = "_QFEa"} : (!fir.ref) -> (!fir.ref, !fir.ref) +!CHECK: omp.parallel { +!CHECK: %[[PAR_TP_A:.*]] = omp.threadprivate %[[A_ADDR]] : !fir.ref -> !fir.ref +!CHECK: %[[PAR_TP_A_DECL:.*]]:2 = hlfir.declare %[[PAR_TP_A]] {uniq_name = "_QFEa"} : (!fir.ref) -> (!fir.ref, !fir.ref) +!CHECK: %{{.*}} = fir.load %[[PAR_TP_A_DECL]]#0 : !fir.ref +!CHECK: omp.terminator +!CHECK: } +!CHECK: return +!CHECK: } +!CHECK: fir.global internal @_QFEa : i32 { +!CHECK: %[[A:.*]] = fir.undefined i32 +!CHECK: fir.has_value %[[A]] : i32 +!CHECK: } + +program main + integer :: a + !$omp threadprivate(a) + call sub() +contains + subroutine sub() + !$omp parallel + print *, a + !$omp end parallel + end +end diff --git a/flang/test/Lower/OpenMP/threadprivate-host-association.f90 b/flang/test/Lower/OpenMP/threadprivate-host-association.f90 new file mode 100644 index 0000000000000..98f7b51bb9711 --- /dev/null +++ b/flang/test/Lower/OpenMP/threadprivate-host-association.f90 @@ -0,0 +1,42 @@ +! This test checks lowering of OpenMP Threadprivate Directive. +! Test for threadprivate variable in host association. + +!RUN: %flang_fc1 -emit-hlfir -fopenmp %s -o - | FileCheck %s + +!CHECK: func.func @_QQmain() attributes {fir.bindc_name = "main"} { +!CHECK: %[[A:.*]] = fir.address_of(@_QFEa) : !fir.ref +!CHECK: %[[A_DECL:.*]]:2 = hlfir.declare %[[A]] {uniq_name = "_QFEa"} : (!fir.ref) -> (!fir.ref, !fir.ref) +!CHECK: %[[TP_A:.*]] = omp.threadprivate %[[A_DECL]]#1 : !fir.ref -> !fir.ref +!CHECK: %[[TP_A_DECL:.*]]:2 = hlfir.declare %[[TP_A]] {uniq_name = "_QFEa"} : (!fir.ref) -> (!fir.ref, !fir.ref) +!CHECK: fir.call @_QFPsub() fastmath : () -> () +!CHECK: return +!CHECK: } +!CHECK: func.func private @_QFPsub() attributes {fir.internal_proc, llvm.linkage = #llvm.linkage} { +!CHECK: %[[A:.*]] = fir.address_of(@_QFEa) : !fir.ref +!CHECK: %[[A_DECL:.*]]:2 = hlfir.declare %[[A]] {uniq_name = "_QFEa"} : (!fir.ref) -> (!fir.ref, !fir.ref) +!CHECK: %[[TP_A:.*]] = omp.threadprivate %[[A_DECL]]#1 : !fir.ref -> !fir.ref +!CHECK: %[[TP_A_DECL:.*]]:2 = hlfir.declare %[[TP_A]] {uniq_name = "_QFEa"} : (!fir.ref) -> (!fir.ref, !fir.ref) +!CHECK: omp.parallel { +!CHECK: %[[PAR_TP_A:.*]] = omp.threadprivate %[[A_DECL]]#1 : !fir.ref -> !fir.ref +!CHECK: %[[PAR_TP_A_DECL:.*]]:2 = hlfir.declare %[[PAR_TP_A]] {uniq_name = "_QFEa"} : (!fir.ref) -> (!fir.ref, !fir.ref) +!CHECK: %{{.*}} = fir.load %[[PAR_TP_A_DECL]]#0 : !fir.ref +!CHECK: omp.terminator +!CHECK: } +!CHECK: return +!CHECK: } +!CHECK: fir.global internal @_QFEa : i32 { +!CHECK: %[[A:.*]] = fir.zero_bits i32 +!CHECK: fir.has_value %[[A]] : i32 +!CHECK: } + +program main + integer, save :: a + !$omp threadprivate(a) + call sub() +contains + subroutine sub() + !$omp parallel + print *, a + !$omp end parallel + end +end