diff --git a/flang/include/flang/Lower/AbstractConverter.h b/flang/include/flang/Lower/AbstractConverter.h --- a/flang/include/flang/Lower/AbstractConverter.h +++ b/flang/include/flang/Lower/AbstractConverter.h @@ -16,6 +16,7 @@ #include "flang/Common/Fortran.h" #include "flang/Lower/PFTDefs.h" #include "flang/Optimizer/Builder/BoxValue.h" +#include "flang/Semantics/symbol.h" #include "mlir/IR/BuiltinOps.h" #include "llvm/ADT/ArrayRef.h" @@ -76,6 +77,9 @@ /// Get the mlir instance of a symbol. virtual mlir::Value getSymbolAddress(SymbolRef sym) = 0; + virtual fir::ExtendedValue + getSymbolExtendedValue(const Fortran::semantics::Symbol &sym) = 0; + /// Get the binding of an implied do variable by name. virtual mlir::Value impliedDoBinding(llvm::StringRef name) = 0; @@ -99,6 +103,12 @@ virtual void copyHostAssociateVar(const Fortran::semantics::Symbol &sym) = 0; + /// Collect the set of symbols flagged as \p flag in \p eval region. + virtual void collectSymbolSet( + pft::Evaluation &eval, + llvm::SetVector &symbolSet, + Fortran::semantics::Symbol::Flag flag) = 0; + //===--------------------------------------------------------------------===// // Expressions //===--------------------------------------------------------------------===// diff --git a/flang/include/flang/Lower/OpenMP.h b/flang/include/flang/Lower/OpenMP.h --- a/flang/include/flang/Lower/OpenMP.h +++ b/flang/include/flang/Lower/OpenMP.h @@ -29,6 +29,7 @@ namespace pft { struct Evaluation; +struct Variable; } // namespace pft void genOpenMPConstruct(AbstractConverter &, pft::Evaluation &, @@ -36,6 +37,7 @@ void genOpenMPDeclarativeConstruct(AbstractConverter &, pft::Evaluation &, const parser::OpenMPDeclarativeConstruct &); int64_t getCollapseValue(const Fortran::parser::OmpClauseList &clauseList); +void genThreadprivateOp(AbstractConverter &, const pft::Variable &); } // namespace lower } // namespace Fortran diff --git a/flang/include/flang/Lower/PFTBuilder.h b/flang/include/flang/Lower/PFTBuilder.h --- a/flang/include/flang/Lower/PFTBuilder.h +++ b/flang/include/flang/Lower/PFTBuilder.h @@ -782,6 +782,11 @@ void visitAllSymbols(const FunctionLikeUnit &funit, std::function callBack); +/// Call the provided \p callBack on all symbols that are referenced inside \p +/// eval region. +void visitAllSymbols(const Evaluation &eval, + std::function callBack); + } // namespace Fortran::lower::pft namespace Fortran::lower { diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -313,6 +313,13 @@ return lookupSymbol(sym).getAddr(); } + fir::ExtendedValue + getSymbolExtendedValue(const Fortran::semantics::Symbol &sym) override final { + Fortran::lower::SymbolBox sb = localSymbols.lookupSymbol(sym); + assert(sb && "symbol box not found"); + return sb.toExtendedValue(); + } + mlir::Value impliedDoBinding(llvm::StringRef name) override final { mlir::Value val = localSymbols.lookupImpliedDo(name); if (!val) @@ -500,6 +507,18 @@ // Utility methods //===--------------------------------------------------------------------===// + void collectSymbolSet( + Fortran::lower::pft::Evaluation &eval, + llvm::SetVector &symbolSet, + Fortran::semantics::Symbol::Flag flag) override final { + auto addToList = [&](const Fortran::semantics::Symbol &sym) { + const Fortran::semantics::Symbol &ultimate = sym.GetUltimate(); + if (ultimate.test(flag)) + symbolSet.insert(&ultimate); + }; + Fortran::lower::pft::visitAllSymbols(eval, addToList); + } + mlir::Location getCurrentLocation() override final { return toLocation(); } /// Generate a dummy location. @@ -2447,6 +2466,10 @@ void instantiateVar(const Fortran::lower::pft::Variable &var, Fortran::lower::AggregateStoreMap &storeMap) { Fortran::lower::instantiateVariable(*this, var, localSymbols, storeMap); + if (var.hasSymbol() && + var.getSymbol().test( + Fortran::semantics::Symbol::Flag::OmpThreadprivate)) + Fortran::lower::genThreadprivateOp(*this, var); } /// Prepare to translate a new function diff --git a/flang/lib/Lower/OpenMP.cpp b/flang/lib/Lower/OpenMP.cpp --- a/flang/lib/Lower/OpenMP.cpp +++ b/flang/lib/Lower/OpenMP.cpp @@ -91,6 +91,103 @@ firOpBuilder.restoreInsertionPoint(insPt); } +/// The COMMON block is a global structure. \p commonValue is the base address +/// of the the COMMON block. As the offset from the symbol \p sym, generate the +/// COMMON block member value (commonValue + offset) for the symbol. +/// FIXME: Share the code with `instantiateCommon` in ConvertVariable.cpp. +static mlir::Value +genCommonBlockMember(Fortran::lower::AbstractConverter &converter, + const Fortran::semantics::Symbol &sym, + mlir::Value commonValue) { + auto &firOpBuilder = converter.getFirOpBuilder(); + mlir::Location currentLocation = converter.getCurrentLocation(); + mlir::IntegerType i8Ty = firOpBuilder.getIntegerType(8); + mlir::Type i8Ptr = firOpBuilder.getRefType(i8Ty); + mlir::Type seqTy = firOpBuilder.getRefType(firOpBuilder.getVarLenSeqTy(i8Ty)); + mlir::Value base = + firOpBuilder.createConvert(currentLocation, seqTy, commonValue); + std::size_t byteOffset = sym.GetUltimate().offset(); + mlir::Value offs = firOpBuilder.createIntegerConstant( + currentLocation, firOpBuilder.getIndexType(), byteOffset); + mlir::Value varAddr = firOpBuilder.create( + currentLocation, i8Ptr, base, mlir::ValueRange{offs}); + mlir::Type symType = converter.genType(sym); + return firOpBuilder.createConvert(currentLocation, + firOpBuilder.getRefType(symType), varAddr); +} + +// Get the extended value for \p val by extracting additional variable +// information from \p base. +static fir::ExtendedValue getExtendedValue(fir::ExtendedValue base, + mlir::Value val) { + return base.match( + [&](const fir::MutableBoxValue &box) -> fir::ExtendedValue { + return fir::MutableBoxValue(val, box.nonDeferredLenParams(), {}); + }, + [&](const auto &) -> fir::ExtendedValue { + return fir::substBase(base, val); + }); +} + +static void threadPrivatizeVars(Fortran::lower::AbstractConverter &converter, + Fortran::lower::pft::Evaluation &eval) { + auto &firOpBuilder = converter.getFirOpBuilder(); + mlir::Location currentLocation = converter.getCurrentLocation(); + auto insPt = firOpBuilder.saveInsertionPoint(); + firOpBuilder.setInsertionPointToStart(firOpBuilder.getAllocaBlock()); + + // Get the original ThreadprivateOp corresponding to the symbol and use the + // symbol value from that opeartion to create one ThreadprivateOp copy + // operation inside the parallel region. + auto genThreadprivateOp = [&](Fortran::lower::SymbolRef sym) -> mlir::Value { + mlir::Value symOriThreadprivateValue = converter.getSymbolAddress(sym); + mlir::Operation *op = symOriThreadprivateValue.getDefiningOp(); + assert(mlir::isa(op) && + "The threadprivate operation not created"); + mlir::Value symValue = + mlir::dyn_cast(op).sym_addr(); + return firOpBuilder.create( + currentLocation, symValue.getType(), symValue); + }; + + llvm::SetVector threadprivateSyms; + converter.collectSymbolSet( + eval, threadprivateSyms, + Fortran::semantics::Symbol::Flag::OmpThreadprivate); + + // For a COMMON block, the ThreadprivateOp is generated for itself instead of + // its members, so only bind the value of the new copied ThreadprivateOp + // inside the parallel region to the common block symbol only once for + // multiple members in one COMMON block. + llvm::SetVector commonSyms; + for (std::size_t i = 0; i < threadprivateSyms.size(); i++) { + auto sym = threadprivateSyms[i]; + mlir::Value symThreadprivateValue; + if (const Fortran::semantics::Symbol *common = + Fortran::semantics::FindCommonBlockContaining(sym->GetUltimate())) { + mlir::Value commonThreadprivateValue; + if (commonSyms.contains(common)) { + commonThreadprivateValue = converter.getSymbolAddress(*common); + } else { + commonThreadprivateValue = genThreadprivateOp(*common); + converter.bindSymbol(*common, commonThreadprivateValue); + commonSyms.insert(common); + } + symThreadprivateValue = + genCommonBlockMember(converter, *sym, commonThreadprivateValue); + } else { + symThreadprivateValue = genThreadprivateOp(*sym); + } + + fir::ExtendedValue sexv = converter.getSymbolExtendedValue(*sym); + fir::ExtendedValue symThreadprivateExv = + getExtendedValue(sexv, symThreadprivateValue); + converter.bindSymbol(*sym, symThreadprivateExv); + } + + firOpBuilder.restoreInsertionPoint(insPt); +} + static void genObjectList(const Fortran::parser::OmpObjectList &objectList, Fortran::lower::AbstractConverter &converter, llvm::SmallVectorImpl &operands) { @@ -243,6 +340,9 @@ // Handle privatization. Do not privatize if this is the outer operation. if (clauses && !outerCombined) privatizeVars(converter, *clauses); + + if (std::is_same_v) + threadPrivatizeVars(converter, eval); } static void genOMP(Fortran::lower::AbstractConverter &converter, @@ -993,6 +1093,42 @@ ompConstruct.u); } +void Fortran::lower::genThreadprivateOp( + Fortran::lower::AbstractConverter &converter, + const Fortran::lower::pft::Variable &var) { + fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); + mlir::Location currentLocation = converter.getCurrentLocation(); + + const Fortran::semantics::Symbol &sym = var.getSymbol(); + mlir::Value symThreadprivateValue; + if (const Fortran::semantics::Symbol *common = + Fortran::semantics::FindCommonBlockContaining(sym.GetUltimate())) { + mlir::Value commonValue = converter.getSymbolAddress(*common); + if (mlir::isa(commonValue.getDefiningOp())) { + // Generate ThreadprivateOp for a common block instead of its members and + // only do it once for a common block. + return; + } + // Generate ThreadprivateOp and rebind the common block. + mlir::Value commonThreadprivateValue = + firOpBuilder.create( + currentLocation, commonValue.getType(), commonValue); + converter.bindSymbol(*common, commonThreadprivateValue); + // Generate the threadprivate value for the common block member. + symThreadprivateValue = + genCommonBlockMember(converter, sym, commonThreadprivateValue); + } else { + mlir::Value symValue = converter.getSymbolAddress(sym); + symThreadprivateValue = firOpBuilder.create( + currentLocation, symValue.getType(), symValue); + } + + fir::ExtendedValue sexv = converter.getSymbolExtendedValue(sym); + fir::ExtendedValue symThreadprivateExv = + getExtendedValue(sexv, symThreadprivateValue); + converter.bindSymbol(sym, symThreadprivateExv); +} + void Fortran::lower::genOpenMPDeclarativeConstruct( Fortran::lower::AbstractConverter &converter, Fortran::lower::pft::Evaluation &eval, @@ -1019,7 +1155,8 @@ "OpenMPDeclareTargetConstruct"); }, [&](const Fortran::parser::OpenMPThreadprivate &threadprivate) { - TODO(converter.getCurrentLocation(), "OpenMPThreadprivate"); + // The directive is lowered when instantiating the variable to + // support the case of threadprivate variable declared in module. }, }, ompDeclConstruct.u); diff --git a/flang/lib/Lower/PFTBuilder.cpp b/flang/lib/Lower/PFTBuilder.cpp --- a/flang/lib/Lower/PFTBuilder.cpp +++ b/flang/lib/Lower/PFTBuilder.cpp @@ -1809,3 +1809,12 @@ parser::Walk(functionParserNode, visitor); }); } + +void Fortran::lower::pft::visitAllSymbols( + const Fortran::lower::pft::Evaluation &eval, + const std::function callBack) { + SymbolVisitor visitor{callBack}; + eval.visit([&](const auto &functionParserNode) { + parser::Walk(functionParserNode, visitor); + }); +} diff --git a/flang/test/Lower/OpenMP/Todo/omp-threadprivate.f90 b/flang/test/Lower/OpenMP/Todo/omp-threadprivate.f90 deleted file mode 100644 --- a/flang/test/Lower/OpenMP/Todo/omp-threadprivate.f90 +++ /dev/null @@ -1,10 +0,0 @@ -! This test checks lowering of OpenMP threadprivate Directive. - -// RUN: not flang-new -fc1 -emit-fir -fopenmp %s 2>&1 | FileCheck %s - -program main - integer, save :: x, y - -// CHECK: not yet implemented: OpenMPThreadprivate - !$omp threadprivate(x, y) -end diff --git a/flang/test/Lower/OpenMP/threadprivate-char-array-chararray.f90 b/flang/test/Lower/OpenMP/threadprivate-char-array-chararray.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/OpenMP/threadprivate-char-array-chararray.f90 @@ -0,0 +1,46 @@ +! This test checks lowering of OpenMP Threadprivate Directive. +! Test for character, array, and character array. + +!RUN: %flang_fc1 -emit-fir -fopenmp %s -o - | FileCheck %s + +module test + character :: x + integer :: y(5) + character(5) :: z(5) + + !$omp threadprivate(x, y, z) + +!CHECK-DAG: fir.global @_QMtestEx : !fir.char<1> { +!CHECK-DAG: fir.global @_QMtestEy : !fir.array<5xi32> { +!CHECK-DAG: fir.global @_QMtestEz : !fir.array<5x!fir.char<1,5>> { + +contains + subroutine sub() +!CHECK-DAG: [[ADDR0:%.*]] = fir.address_of(@_QMtestEx) : !fir.ref> +!CHECK-DAG: [[NEWADDR0:%.*]] = omp.threadprivate [[ADDR0]] : !fir.ref> -> !fir.ref> +!CHECK-DAG: [[ADDR1:%.*]] = fir.address_of(@_QMtestEy) : !fir.ref> +!CHECK-DAG: [[NEWADDR1:%.*]] = omp.threadprivate [[ADDR1]] : !fir.ref> -> !fir.ref> +!CHECK-DAG: [[ADDR2:%.*]] = fir.address_of(@_QMtestEz) : !fir.ref>> +!CHECK-DAG: [[NEWADDR2:%.*]] = omp.threadprivate [[ADDR2]] : !fir.ref>> -> !fir.ref>> +!CHECK-DAG: %{{.*}} = fir.convert [[NEWADDR0]] : (!fir.ref>) -> !fir.ref +!CHECK-DAG: %{{.*}} = fir.embox [[NEWADDR1]](%{{.*}}) : (!fir.ref>, !fir.shape<1>) -> !fir.box> +!CHECK-DAG: %{{.*}} = fir.embox [[NEWADDR2]](%{{.*}}) : (!fir.ref>>, !fir.shape<1>) -> !fir.box>> + print *, x, y, z + + !$omp parallel +!CHECK-DAG: [[ADDR33:%.*]] = omp.threadprivate [[ADDR0]] : !fir.ref> -> !fir.ref> +!CHECK-DAG: [[ADDR34:%.*]] = omp.threadprivate [[ADDR1]] : !fir.ref> -> !fir.ref> +!CHECK-DAG: [[ADDR35:%.*]] = omp.threadprivate [[ADDR2]] : !fir.ref>> -> !fir.ref>> +!CHECK-DAG: %{{.*}} = fir.convert [[ADDR33]] : (!fir.ref>) -> !fir.ref +!CHECK-DAG: %{{.*}} = fir.embox [[ADDR34]](%{{.*}}) : (!fir.ref>, !fir.shape<1>) -> !fir.box> +!CHECK-DAG: %{{.*}} = fir.embox [[ADDR35]](%{{.*}}) : (!fir.ref>>, !fir.shape<1>) -> !fir.box>> + print *, x, y, z + !$omp end parallel + +!CHECK-DAG: %{{.*}} = fir.convert [[NEWADDR0]] : (!fir.ref>) -> !fir.ref +!CHECK-DAG: %{{.*}} = fir.embox [[NEWADDR1]](%{{.*}}) : (!fir.ref>, !fir.shape<1>) -> !fir.box> +!CHECK-DAG: %{{.*}} = fir.embox [[NEWADDR2]](%{{.*}}) : (!fir.ref>>, !fir.shape<1>) -> !fir.box>> + print *, x, y, z + + end +end diff --git a/flang/test/Lower/OpenMP/threadprivate-commonblock.f90 b/flang/test/Lower/OpenMP/threadprivate-commonblock.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/OpenMP/threadprivate-commonblock.f90 @@ -0,0 +1,91 @@ +! This test checks lowering of OpenMP Threadprivate Directive. +! Test for common block. + +!RUN: %flang_fc1 -emit-fir -fopenmp %s -o - | FileCheck %s + +module test + integer:: a + real :: b(2) + complex, pointer :: c, d(:) + character(5) :: e, f(2) + common /blk/ a, b, c, d, e, f + + !$omp threadprivate(/blk/) + +!CHECK: fir.global common @_QBblk(dense<0> : vector<103xi8>) : !fir.array<103xi8> + +contains + subroutine sub() +!CHECK: [[ADDR0:%.*]] = fir.address_of(@_QBblk) : !fir.ref> +!CHECK: [[NEWADDR0:%.*]] = omp.threadprivate [[ADDR0]] : !fir.ref> -> !fir.ref> +!CHECK-DAG: [[ADDR1:%.*]] = fir.convert [[NEWADDR0]] : (!fir.ref>) -> !fir.ref> +!CHECK-DAG: [[C0:%.*]] = arith.constant 0 : index +!CHECK-DAG: [[ADDR2:%.*]] = fir.coordinate_of [[ADDR1]], [[C0]] : (!fir.ref>, index) -> !fir.ref +!CHECK-DAG: [[ADDR3:%.*]] = fir.convert [[ADDR2]] : (!fir.ref) -> !fir.ref +!CHECK-DAG: [[ADDR4:%.*]] = fir.convert [[NEWADDR0]] : (!fir.ref>) -> !fir.ref> +!CHECK-DAG: [[C1:%.*]] = arith.constant 4 : index +!CHECK-DAG: [[ADDR5:%.*]] = fir.coordinate_of [[ADDR4]], [[C1]] : (!fir.ref>, index) -> !fir.ref +!CHECK-DAG: [[ADDR6:%.*]] = fir.convert [[ADDR5]] : (!fir.ref) -> !fir.ref> +!CHECK-DAG: [[ADDR7:%.*]] = fir.convert [[NEWADDR0]] : (!fir.ref>) -> !fir.ref> +!CHECK-DAG: [[C2:%.*]] = arith.constant 16 : index +!CHECK-DAG: [[ADDR8:%.*]] = fir.coordinate_of [[ADDR7]], [[C2]] : (!fir.ref>, index) -> !fir.ref +!CHECK-DAG: [[ADDR9:%.*]] = fir.convert [[ADDR8]] : (!fir.ref) -> !fir.ref>>> +!CHECK-DAG: [[ADDR10:%.*]] = fir.convert [[NEWADDR0]] : (!fir.ref>) -> !fir.ref> +!CHECK-DAG: [[C3:%.*]] = arith.constant 40 : index +!CHECK-DAG: [[ADDR11:%.*]] = fir.coordinate_of [[ADDR10]], [[C3]] : (!fir.ref>, index) -> !fir.ref +!CHECK-DAG: [[ADDR12:%.*]] = fir.convert [[ADDR11]] : (!fir.ref) -> !fir.ref>>>> +!CHECK-DAG: [[ADDR13:%.*]] = fir.convert [[NEWADDR0]] : (!fir.ref>) -> !fir.ref> +!CHECK-DAG: [[C4:%.*]] = arith.constant 88 : index +!CHECK-DAG: [[ADDR14:%.*]] = fir.coordinate_of [[ADDR13]], [[C4]] : (!fir.ref>, index) -> !fir.ref +!CHECK-DAG: [[ADDR15:%.*]] = fir.convert [[ADDR14]] : (!fir.ref) -> !fir.ref> +!CHECK-DAG: [[ADDR16:%.*]] = fir.convert [[NEWADDR0]] : (!fir.ref>) -> !fir.ref> +!CHECK-DAG: [[C5:%.*]] = arith.constant 93 : index +!CHECK-DAG: [[ADDR17:%.*]] = fir.coordinate_of [[ADDR16]], [[C5]] : (!fir.ref>, index) -> !fir.ref +!CHECK-DAG: [[ADDR18:%.*]] = fir.convert [[ADDR17]] : (!fir.ref) -> !fir.ref>> +!CHECK-DAG: %{{.*}} = fir.load [[ADDR3]] : !fir.ref +!CHECK-DAG: %{{.*}} = fir.embox [[ADDR6]](%{{.*}}) : (!fir.ref>, !fir.shape<1>) -> !fir.box> +!CHECK-DAG: %{{.*}} = fir.load [[ADDR9]] : !fir.ref>>> +!CHECK-DAG: %{{.*}} = fir.load [[ADDR12]] : !fir.ref>>>> +!CHECK-DAG: %{{.*}} = fir.convert [[ADDR15]] : (!fir.ref>) -> !fir.ref +!CHECK-DAG: %{{.*}} = fir.embox [[ADDR18]](%{{.*}}) : (!fir.ref>>, !fir.shape<1>) -> !fir.box>> + print *, a, b, c, d, e, f + + !$omp parallel +!CHECK: [[ADDR77:%.*]] = omp.threadprivate [[ADDR0]] : !fir.ref> -> !fir.ref> +!CHECK-DAG: [[ADDR78:%.*]] = fir.convert [[ADDR77]] : (!fir.ref>) -> !fir.ref> +!CHECK-DAG: [[ADDR79:%.*]] = fir.coordinate_of [[ADDR78]], [[C0:%.*]] : (!fir.ref>, index) -> !fir.ref +!CHECK-DAG: [[ADDR80:%.*]] = fir.convert [[ADDR79:%.*]] : (!fir.ref) -> !fir.ref +!CHECK-DAG: [[ADDR81:%.*]] = fir.convert [[ADDR77]] : (!fir.ref>) -> !fir.ref> +!CHECK-DAG: [[ADDR82:%.*]] = fir.coordinate_of [[ADDR81]], [[C1:%.*]] : (!fir.ref>, index) -> !fir.ref +!CHECK-DAG: [[ADDR83:%.*]] = fir.convert [[ADDR82:%.*]] : (!fir.ref) -> !fir.ref> +!CHECK-DAG: [[ADDR84:%.*]] = fir.convert [[ADDR77]] : (!fir.ref>) -> !fir.ref> +!CHECK-DAG: [[ADDR85:%.*]] = fir.coordinate_of [[ADDR84]], [[C2:%.*]] : (!fir.ref>, index) -> !fir.ref +!CHECK-DAG: [[ADDR86:%.*]] = fir.convert [[ADDR85:%.*]] : (!fir.ref) -> !fir.ref>>> +!CHECK-DAG: [[ADDR87:%.*]] = fir.convert [[ADDR77]] : (!fir.ref>) -> !fir.ref> +!CHECK-DAG: [[ADDR88:%.*]] = fir.coordinate_of [[ADDR87]], [[C3:%.*]] : (!fir.ref>, index) -> !fir.ref +!CHECK-DAG: [[ADDR89:%.*]] = fir.convert [[ADDR88:%.*]] : (!fir.ref) -> !fir.ref>>>> +!CHECK-DAG: [[ADDR90:%.*]] = fir.convert [[ADDR77]] : (!fir.ref>) -> !fir.ref> +!CHECK-DAG: [[ADDR91:%.*]] = fir.coordinate_of [[ADDR90]], [[C4:%.*]] : (!fir.ref>, index) -> !fir.ref +!CHECK-DAG: [[ADDR92:%.*]] = fir.convert [[ADDR91:%.*]] : (!fir.ref) -> !fir.ref> +!CHECK-DAG: [[ADDR93:%.*]] = fir.convert [[ADDR77]] : (!fir.ref>) -> !fir.ref> +!CHECK-DAG: [[ADDR94:%.*]] = fir.coordinate_of [[ADDR93]], [[C5:%.*]] : (!fir.ref>, index) -> !fir.ref +!CHECK-DAG: [[ADDR95:%.*]] = fir.convert [[ADDR94:%.*]] : (!fir.ref) -> !fir.ref>> +!CHECK-DAG: %{{.*}} = fir.load [[ADDR80]] : !fir.ref +!CHECK-DAG: %{{.*}} = fir.embox [[ADDR83]](%{{.*}}) : (!fir.ref>, !fir.shape<1>) -> !fir.box> +!CHECK-DAG: %{{.*}} = fir.load [[ADDR86]] : !fir.ref>>> +!CHECK-DAG: %{{.*}} = fir.load [[ADDR89]] : !fir.ref>>>> +!CHECK-DAG: %{{.*}} = fir.convert [[ADDR92]] : (!fir.ref>) -> !fir.ref +!CHECK-DAG: %{{.*}} = fir.embox [[ADDR95]](%{{.*}}) : (!fir.ref>>, !fir.shape<1>) -> !fir.box>> + print *, a, b, c, d, e, f + !$omp end parallel + +!CHECK-DAG: %{{.*}} = fir.load [[ADDR3]] : !fir.ref +!CHECK-DAG: %{{.*}} = fir.embox [[ADDR6]](%{{.*}}) : (!fir.ref>, !fir.shape<1>) -> !fir.box> +!CHECK-DAG: %{{.*}} = fir.load [[ADDR9]] : !fir.ref>>> +!CHECK-DAG: %{{.*}} = fir.load [[ADDR12]] : !fir.ref>>>> +!CHECK-DAG: %{{.*}} = fir.convert [[ADDR15]] : (!fir.ref>) -> !fir.ref +!CHECK-DAG: %{{.*}} = fir.embox [[ADDR18]](%{{.*}}) : (!fir.ref>>, !fir.shape<1>) -> !fir.box>> + print *, a, b, c, d, e, f + + end +end diff --git a/flang/test/Lower/OpenMP/threadprivate-integer-different-kinds.f90 b/flang/test/Lower/OpenMP/threadprivate-integer-different-kinds.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/OpenMP/threadprivate-integer-different-kinds.f90 @@ -0,0 +1,67 @@ +! This test checks lowering of OpenMP Threadprivate Directive. +! Test for variables with different kind. + +!REQUIRES: shell +!RUN: %flang_fc1 -emit-fir -fopenmp %s -o - | FileCheck %s + +program test + integer, save :: i + integer(kind=1), save :: i1 + integer(kind=2), save :: i2 + integer(kind=4), save :: i4 + integer(kind=8), save :: i8 + integer(kind=16), save :: i16 + +!CHECK-DAG: [[ADDR0:%.*]] = fir.address_of(@_QFEi) : !fir.ref +!CHECK-DAG: [[NEWADDR0:%.*]] = omp.threadprivate [[ADDR0]] : !fir.ref -> !fir.ref +!CHECK-DAG: [[ADDR1:%.*]] = fir.address_of(@_QFEi1) : !fir.ref +!CHECK-DAG: [[NEWADDR1:%.*]] = omp.threadprivate [[ADDR1]] : !fir.ref -> !fir.ref +!CHECK-DAG: [[ADDR2:%.*]] = fir.address_of(@_QFEi16) : !fir.ref +!CHECK-DAG: [[NEWADDR2:%.*]] = omp.threadprivate [[ADDR2]] : !fir.ref -> !fir.ref +!CHECK-DAG: [[ADDR3:%.*]] = fir.address_of(@_QFEi2) : !fir.ref +!CHECK-DAG: [[NEWADDR3:%.*]] = omp.threadprivate [[ADDR3]] : !fir.ref -> !fir.ref +!CHECK-DAG: [[ADDR4:%.*]] = fir.address_of(@_QFEi4) : !fir.ref +!CHECK-DAG: [[NEWADDR4:%.*]] = omp.threadprivate [[ADDR4]] : !fir.ref -> !fir.ref +!CHECK-DAG: [[ADDR5:%.*]] = fir.address_of(@_QFEi8) : !fir.ref +!CHECK-DAG: [[NEWADDR5:%.*]] = omp.threadprivate [[ADDR5]] : !fir.ref -> !fir.ref + !$omp threadprivate(i, i1, i2, i4, i8, i16) + +!CHECK-DAG: %{{.*}} = fir.load [[NEWADDR0]] : !fir.ref +!CHECK-DAG: %{{.*}} = fir.load [[NEWADDR1]] : !fir.ref +!CHECK-DAG: %{{.*}} = fir.load [[NEWADDR2]] : !fir.ref +!CHECK-DAG: %{{.*}} = fir.load [[NEWADDR3]] : !fir.ref +!CHECK-DAG: %{{.*}} = fir.load [[NEWADDR4]] : !fir.ref +!CHECK-DAG: %{{.*}} = fir.load [[NEWADDR5]] : !fir.ref + print *, i, i1, i2, i4, i8, i16 + + !$omp parallel +!CHECK-DAG: [[ADDR39:%.*]] = omp.threadprivate [[ADDR0]] : !fir.ref -> !fir.ref +!CHECK-DAG: [[ADDR40:%.*]] = omp.threadprivate [[ADDR1]] : !fir.ref -> !fir.ref +!CHECK-DAG: [[ADDR41:%.*]] = omp.threadprivate [[ADDR2]] : !fir.ref -> !fir.ref +!CHECK-DAG: [[ADDR42:%.*]] = omp.threadprivate [[ADDR3]] : !fir.ref -> !fir.ref +!CHECK-DAG: [[ADDR43:%.*]] = omp.threadprivate [[ADDR4]] : !fir.ref -> !fir.ref +!CHECK-DAG: [[ADDR44:%.*]] = omp.threadprivate [[ADDR5]] : !fir.ref -> !fir.ref +!CHECK-DAG: %{{.*}} = fir.load [[ADDR39]] : !fir.ref +!CHECK-DAG: %{{.*}} = fir.load [[ADDR40]] : !fir.ref +!CHECK-DAG: %{{.*}} = fir.load [[ADDR41]] : !fir.ref +!CHECK-DAG: %{{.*}} = fir.load [[ADDR42]] : !fir.ref +!CHECK-DAG: %{{.*}} = fir.load [[ADDR43]] : !fir.ref +!CHECK-DAG: %{{.*}} = fir.load [[ADDR44]] : !fir.ref + print *, i, i1, i2, i4, i8, i16 + !$omp end parallel + +!CHECK-DAG: %{{.*}} = fir.load [[NEWADDR0]] : !fir.ref +!CHECK-DAG: %{{.*}} = fir.load [[NEWADDR1]] : !fir.ref +!CHECK-DAG: %{{.*}} = fir.load [[NEWADDR2]] : !fir.ref +!CHECK-DAG: %{{.*}} = fir.load [[NEWADDR3]] : !fir.ref +!CHECK-DAG: %{{.*}} = fir.load [[NEWADDR4]] : !fir.ref +!CHECK-DAG: %{{.*}} = fir.load [[NEWADDR5]] : !fir.ref + print *, i, i1, i2, i4, i8, i16 + +!CHECK-DAG: fir.global internal @_QFEi : i32 { +!CHECK-DAG: fir.global internal @_QFEi1 : i8 { +!CHECK-DAG: fir.global internal @_QFEi16 : i128 { +!CHECK-DAG: fir.global internal @_QFEi2 : i16 { +!CHECK-DAG: fir.global internal @_QFEi4 : i32 { +!CHECK-DAG: fir.global internal @_QFEi8 : i64 { +end diff --git a/flang/test/Lower/OpenMP/threadprivate-pointer-allocatable.f90 b/flang/test/Lower/OpenMP/threadprivate-pointer-allocatable.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/OpenMP/threadprivate-pointer-allocatable.f90 @@ -0,0 +1,51 @@ +! This test checks lowering of OpenMP Threadprivate Directive. +! Test for allocatable and pointer variables. + +!RUN: %flang_fc1 -emit-fir -fopenmp %s -o - | FileCheck %s + +module test + integer, pointer :: x(:), m + real, allocatable :: y(:), n + + !$omp threadprivate(x, y, m, n) + +!CHECK-DAG: fir.global @_QMtestEm : !fir.box> { +!CHECK-DAG: fir.global @_QMtestEn : !fir.box> { +!CHECK-DAG: fir.global @_QMtestEx : !fir.box>> { +!CHECK-DAG: fir.global @_QMtestEy : !fir.box>> { + +contains + subroutine sub() +!CHECK-DAG: [[ADDR0:%.*]] = fir.address_of(@_QMtestEm) : !fir.ref>> +!CHECK-DAG: [[NEWADDR0:%.*]] = omp.threadprivate [[ADDR0]] : !fir.ref>> -> !fir.ref>> +!CHECK-DAG: [[ADDR1:%.*]] = fir.address_of(@_QMtestEn) : !fir.ref>> +!CHECK-DAG: [[NEWADDR1:%.*]] = omp.threadprivate [[ADDR1]] : !fir.ref>> -> !fir.ref>> +!CHECK-DAG: [[ADDR2:%.*]] = fir.address_of(@_QMtestEx) : !fir.ref>>> +!CHECK-DAG: [[NEWADDR2:%.*]] = omp.threadprivate [[ADDR2]] : !fir.ref>>> -> !fir.ref>>> +!CHECK-DAG: [[ADDR3:%.*]] = fir.address_of(@_QMtestEy) : !fir.ref>>> +!CHECK-DAG: [[NEWADDR3:%.*]] = omp.threadprivate [[ADDR3]] : !fir.ref>>> -> !fir.ref>>> +!CHECK-DAG: %{{.*}} = fir.load [[NEWADDR2]] : !fir.ref>>> +!CHECK-DAG: %{{.*}} = fir.load [[NEWADDR3]] : !fir.ref>>> +!CHECK-DAG: %{{.*}} = fir.load [[NEWADDR0]] : !fir.ref>> +!CHECK-DAG: %{{.*}} = fir.load [[NEWADDR1]] : !fir.ref>> + print *, x, y, m, n + + !$omp parallel +!CHECK-DAG: [[ADDR54:%.*]] = omp.threadprivate [[ADDR0]] : !fir.ref>> -> !fir.ref>> +!CHECK-DAG: [[ADDR55:%.*]] = omp.threadprivate [[ADDR1]] : !fir.ref>> -> !fir.ref>> +!CHECK-DAG: [[ADDR56:%.*]] = omp.threadprivate [[ADDR2]] : !fir.ref>>> -> !fir.ref>>> +!CHECK-DAG: [[ADDR57:%.*]] = omp.threadprivate [[ADDR3]] : !fir.ref>>> -> !fir.ref>>> +!CHECK-DAG: %{{.*}} = fir.load [[ADDR56]] : !fir.ref>>> +!CHECK-DAG: %{{.*}} = fir.load [[ADDR57]] : !fir.ref>>> +!CHECK-DAG: %{{.*}} = fir.load [[ADDR54]] : !fir.ref>> +!CHECK-DAG: %{{.*}} = fir.load [[ADDR55]] : !fir.ref>> + print *, x, y, m, n + !$omp end parallel + +!CHECK-DAG: %{{.*}} = fir.load [[NEWADDR2]] : !fir.ref>>> +!CHECK-DAG: %{{.*}} = fir.load [[NEWADDR3]] : !fir.ref>>> +!CHECK-DAG: %{{.*}} = fir.load [[NEWADDR0]] : !fir.ref>> +!CHECK-DAG: %{{.*}} = fir.load [[NEWADDR1]] : !fir.ref>> + print *, x, y, m, n + end +end diff --git a/flang/test/Lower/OpenMP/threadprivate-real-logical-complex-derivedtype.f90 b/flang/test/Lower/OpenMP/threadprivate-real-logical-complex-derivedtype.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/OpenMP/threadprivate-real-logical-complex-derivedtype.f90 @@ -0,0 +1,58 @@ +! This test checks lowering of OpenMP Threadprivate Directive. +! Test for real, logical, complex, and derived type. + +!RUN: %flang_fc1 -emit-fir -fopenmp %s -o - | FileCheck %s + +module test + type my_type + integer :: t_i + real :: t_arr(5) + end type my_type + real :: x + complex :: y + logical :: z + type(my_type) :: t + + !$omp threadprivate(x, y, z, t) + +!CHECK-DAG: fir.global @_QMtestEt : !fir.type<_QMtestTmy_type{t_i:i32,t_arr:!fir.array<5xf32>}> { +!CHECK-DAG: fir.global @_QMtestEx : f32 { +!CHECK-DAG: fir.global @_QMtestEy : !fir.complex<4> { +!CHECK-DAG: fir.global @_QMtestEz : !fir.logical<4> { + +contains + subroutine sub() +!CHECK-DAG: [[ADDR0:%.*]] = fir.address_of(@_QMtestEt) : !fir.ref}>> +!CHECK-DAG: [[NEWADDR0:%.*]] = omp.threadprivate [[ADDR0]] : !fir.ref}>> -> !fir.ref}>> +!CHECK-DAG: [[ADDR1:%.*]] = fir.address_of(@_QMtestEx) : !fir.ref +!CHECK-DAG: [[NEWADDR1:%.*]] = omp.threadprivate [[ADDR1]] : !fir.ref -> !fir.ref +!CHECK-DAG: [[ADDR2:%.*]] = fir.address_of(@_QMtestEy) : !fir.ref> +!CHECK-DAG: [[NEWADDR2:%.*]] = omp.threadprivate [[ADDR2]] : !fir.ref> -> !fir.ref> +!CHECK-DAG: [[ADDR3:%.*]] = fir.address_of(@_QMtestEz) : !fir.ref> +!CHECK-DAG: [[NEWADDR3:%.*]] = omp.threadprivate [[ADDR3]] : !fir.ref> -> !fir.ref> +!CHECK-DAG: %{{.*}} = fir.load [[NEWADDR1]] : !fir.ref +!CHECK-DAG: %{{.*}} = fir.load [[NEWADDR2]] : !fir.ref> +!CHECK-DAG: %{{.*}} = fir.load [[NEWADDR3]] : !fir.ref> +!CHECK-DAG: %{{.*}} = fir.coordinate_of [[NEWADDR0]] + print *, x, y, z, t%t_i + + !$omp parallel +!CHECK-DAG: [[ADDR38:%.*]] = omp.threadprivate [[ADDR0]] : !fir.ref}>> -> !fir.ref}>> +!CHECK-DAG: [[ADDR39:%.*]] = omp.threadprivate [[ADDR1]] : !fir.ref -> !fir.ref +!CHECK-DAG: [[ADDR40:%.*]] = omp.threadprivate [[ADDR2]] : !fir.ref> -> !fir.ref> +!CHECK-DAG: [[ADDR41:%.*]] = omp.threadprivate [[ADDR3]] : !fir.ref> -> !fir.ref> +!CHECK-DAG: %{{.*}} = fir.load [[ADDR39]] : !fir.ref +!CHECK-DAG: %{{.*}} = fir.load [[ADDR40]] : !fir.ref> +!CHECK-DAG: %{{.*}} = fir.load [[ADDR41]] : !fir.ref> +!CHECK-DAG: %{{.*}} = fir.coordinate_of [[ADDR38]] + print *, x, y, z, t%t_i + !$omp end parallel + +!CHECK-DAG: %{{.*}} = fir.load [[NEWADDR1]] : !fir.ref +!CHECK-DAG: %{{.*}} = fir.load [[NEWADDR2]] : !fir.ref> +!CHECK-DAG: %{{.*}} = fir.load [[NEWADDR3]] : !fir.ref> +!CHECK-DAG: %{{.*}} = fir.coordinate_of [[NEWADDR0]] + print *, x, y, z, t%t_i + + end +end diff --git a/flang/test/Lower/OpenMP/threadprivate-use-association.f90 b/flang/test/Lower/OpenMP/threadprivate-use-association.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/OpenMP/threadprivate-use-association.f90 @@ -0,0 +1,74 @@ +! This test checks lowering of OpenMP Threadprivate Directive. +! Test for threadprivate variable in use association. + +!RUN: %flang_fc1 -emit-fir -fopenmp %s -o - | FileCheck %s + +!CHECK-DAG: fir.global common @_QBblk(dense<0> : vector<24xi8>) : !fir.array<24xi8> +!CHECK-DAG: fir.global @_QMtestEy : f32 { + +module test + integer :: x + real :: y, z(5) + common /blk/ x, z + + !$omp threadprivate(y, /blk/) + +contains + subroutine sub() +! CHECK-LABEL: @_QMtestPsub +!CHECK-DAG: [[ADDR0:%.*]] = fir.address_of(@_QBblk) : !fir.ref> +!CHECK-DAG: [[NEWADDR0:%.*]] = omp.threadprivate [[ADDR0]] : !fir.ref> -> !fir.ref> +!CHECK-DAG: [[ADDR1:%.*]] = fir.address_of(@_QMtestEy) : !fir.ref +!CHECK-DAG: [[NEWADDR1:%.*]] = omp.threadprivate [[ADDR1]] : !fir.ref -> !fir.ref + + !$omp parallel +!CHECK-DAG: [[ADDR2:%.*]] = omp.threadprivate [[ADDR0]] : !fir.ref> -> !fir.ref> +!CHECK-DAG: [[ADDR3:%.*]] = omp.threadprivate [[ADDR1]] : !fir.ref -> !fir.ref +!CHECK-DAG: [[ADDR4:%.*]] = fir.convert [[ADDR2]] : (!fir.ref>) -> !fir.ref> +!CHECK-DAG: [[ADDR5:%.*]] = fir.coordinate_of [[ADDR4]], %{{.*}} : (!fir.ref>, index) -> !fir.ref +!CHECK-DAG: [[ADDR6:%.*]] = fir.convert [[ADDR5:%.*]] : (!fir.ref) -> !fir.ref +!CHECK-DAG: [[ADDR7:%.*]] = fir.convert [[ADDR2]] : (!fir.ref>) -> !fir.ref> +!CHECK-DAG: [[ADDR8:%.*]] = fir.coordinate_of [[ADDR7]], %{{.*}} : (!fir.ref>, index) -> !fir.ref +!CHECK-DAG: [[ADDR9:%.*]] = fir.convert [[ADDR8:%.*]] : (!fir.ref) -> !fir.ref> +!CHECK-DAG: %{{.*}} = fir.load [[ADDR6]] : !fir.ref +!CHECK-DAG: %{{.*}} = fir.load [[ADDR3]] : !fir.ref +!CHECK-DAG: %{{.*}} = fir.embox [[ADDR9]](%{{.*}}) : (!fir.ref>, !fir.shape<1>) -> !fir.box> + print *, x, y, z + !$omp end parallel + end +end + +program main + use test + integer :: x1 + real :: z1(5) + common /blk/ x1, z1 + + !$omp threadprivate(/blk/) + + call sub() + +! CHECK-LABEL: @_QQmain() +!CHECK-DAG: [[ADDR0:%.*]] = fir.address_of(@_QBblk) : !fir.ref> +!CHECK-DAG: [[NEWADDR0:%.*]] = omp.threadprivate [[ADDR0]] : !fir.ref> -> !fir.ref> +!CHECK-DAG: [[ADDR1:%.*]] = fir.address_of(@_QBblk) : !fir.ref> +!CHECK-DAG: [[NEWADDR1:%.*]] = omp.threadprivate [[ADDR1]] : !fir.ref> -> !fir.ref> +!CHECK-DAG: [[ADDR2:%.*]] = fir.address_of(@_QMtestEy) : !fir.ref +!CHECK-DAG: [[NEWADDR2:%.*]] = omp.threadprivate [[ADDR2]] : !fir.ref -> !fir.ref + + !$omp parallel +!CHECK-DAG: [[ADDR4:%.*]] = omp.threadprivate [[ADDR1]] : !fir.ref> -> !fir.ref> +!CHECK-DAG: [[ADDR5:%.*]] = omp.threadprivate [[ADDR2]] : !fir.ref -> !fir.ref +!CHECK-DAG: [[ADDR6:%.*]] = fir.convert [[ADDR4]] : (!fir.ref>) -> !fir.ref> +!CHECK-DAG: [[ADDR7:%.*]] = fir.coordinate_of [[ADDR6]], %{{.*}} : (!fir.ref>, index) -> !fir.ref +!CHECK-DAG: [[ADDR8:%.*]] = fir.convert [[ADDR7:%.*]] : (!fir.ref) -> !fir.ref +!CHECK-DAG: [[ADDR9:%.*]] = fir.convert [[ADDR4]] : (!fir.ref>) -> !fir.ref> +!CHECK-DAG: [[ADDR10:%.*]] = fir.coordinate_of [[ADDR9]], %{{.*}} : (!fir.ref>, index) -> !fir.ref +!CHECK-DAG: [[ADDR11:%.*]] = fir.convert [[ADDR10:%.*]] : (!fir.ref) -> !fir.ref> +!CHECK-DAG: %{{.*}} = fir.load [[ADDR8]] : !fir.ref +!CHECK-DAG: %{{.*}} = fir.load [[ADDR5]] : !fir.ref +!CHECK-DAG: %{{.*}} = fir.embox [[ADDR11]](%{{.*}}) : (!fir.ref>, !fir.shape<1>) -> !fir.box> + print *, x1, y, z1 + !$omp end parallel + +end