diff --git a/flang/lib/Lower/OpenMP/ClauseProcessor.cpp b/flang/lib/Lower/OpenMP/ClauseProcessor.cpp index 2dd89168ca09..e018a2d93743 100644 --- a/flang/lib/Lower/OpenMP/ClauseProcessor.cpp +++ b/flang/lib/Lower/OpenMP/ClauseProcessor.cpp @@ -17,6 +17,7 @@ #include "flang/Lower/OpenMP/Clauses.h" #include "flang/Lower/PFTBuilder.h" #include "flang/Lower/Support/ReductionProcessor.h" +#include "flang/Optimizer/Dialect/FIRType.h" #include "flang/Parser/tools.h" #include "flang/Semantics/tools.h" #include "flang/Utils/OpenMP.h" @@ -1228,26 +1229,66 @@ void ClauseProcessor::processMapObjects( llvm::StringRef mapperIdNameRef) const { fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); - auto getDefaultMapperID = [&](const omp::Object &object, - std::string &mapperIdName) { - if (!mlir::isa( - firOpBuilder.getRegion().getParentOp())) { - const semantics::DerivedTypeSpec *typeSpec = nullptr; + auto getSymbolDerivedType = [](const semantics::Symbol &symbol) + -> const semantics::DerivedTypeSpec * { + const semantics::Symbol &ultimate = symbol.GetUltimate(); + if (const semantics::DeclTypeSpec *declType = ultimate.GetType()) + if (const auto *derived = declType->AsDerived()) + return derived; + return nullptr; + }; - if (object.sym()->owner().IsDerivedType()) - typeSpec = object.sym()->owner().derivedTypeSpec(); - else if (object.sym()->GetType() && - object.sym()->GetType()->category() == - semantics::DeclTypeSpec::TypeDerived) - typeSpec = &object.sym()->GetType()->derivedTypeSpec(); + auto addImplicitMapper = [&](const omp::Object &object, + std::string &mapperIdName, + bool allowGenerate) -> mlir::FlatSymbolRefAttr { + if (mapperIdName.empty()) + return mlir::FlatSymbolRefAttr(); - if (typeSpec) { - mapperIdName = - typeSpec->name().ToString() + llvm::omp::OmpDefaultMapperName; - if (auto *sym = converter.getCurrentScope().FindSymbol(mapperIdName)) - mapperIdName = converter.mangleName(mapperIdName, sym->owner()); - } + if (converter.getModuleOp().lookupSymbol(mapperIdName)) + return mlir::FlatSymbolRefAttr::get(&converter.getMLIRContext(), + mapperIdName); + + if (!allowGenerate) + return mlir::FlatSymbolRefAttr(); + + const semantics::DerivedTypeSpec *typeSpec = + getSymbolDerivedType(*object.sym()); + if (!typeSpec && object.sym()->owner().IsDerivedType()) + typeSpec = object.sym()->owner().derivedTypeSpec(); + + if (!typeSpec) + return mlir::FlatSymbolRefAttr(); + + mlir::Type type = converter.genType(*typeSpec); + auto recordType = mlir::dyn_cast(type); + if (!recordType) + return mlir::FlatSymbolRefAttr(); + + return getOrGenImplicitDefaultDeclareMapper(converter, clauseLocation, + recordType, mapperIdName); + }; + + auto getDefaultMapperID = + [&](const semantics::DerivedTypeSpec *typeSpec) -> std::string { + if (mlir::isa( + firOpBuilder.getRegion().getParentOp()) || + !typeSpec) + return {}; + + std::string mapperIdName = + typeSpec->name().ToString() + llvm::omp::OmpDefaultMapperName; + if (auto *sym = converter.getCurrentScope().FindSymbol(mapperIdName)) { + mapperIdName = converter.mangleName(mapperIdName, sym->owner()); + } else { + mapperIdName = converter.mangleName(mapperIdName, *typeSpec->GetScope()); } + + // Make sure we don't return a mapper to self. + if (auto declMapOp = mlir::dyn_cast( + firOpBuilder.getRegion().getParentOp())) + if (mapperIdName == declMapOp.getSymName()) + return {}; + return mapperIdName; }; // Create the mapper symbol from its name, if specified. @@ -1256,8 +1297,13 @@ void ClauseProcessor::processMapObjects( mapperIdNameRef != "__implicit_mapper") { std::string mapperIdName = mapperIdNameRef.str(); const omp::Object &object = objects.front(); - if (mapperIdNameRef == "default") - getDefaultMapperID(object, mapperIdName); + if (mapperIdNameRef == "default") { + const semantics::DerivedTypeSpec *typeSpec = + getSymbolDerivedType(*object.sym()); + if (!typeSpec && object.sym()->owner().IsDerivedType()) + typeSpec = object.sym()->owner().derivedTypeSpec(); + mapperIdName = getDefaultMapperID(typeSpec); + } assert(converter.getModuleOp().lookupSymbol(mapperIdName) && "mapper not found"); mapperId = @@ -1295,13 +1341,25 @@ void ClauseProcessor::processMapObjects( } } + const semantics::DerivedTypeSpec *objectTypeSpec = + getSymbolDerivedType(*object.sym()); + if (mapperIdNameRef == "__implicit_mapper") { - std::string mapperIdName; - getDefaultMapperID(object, mapperIdName); - mapperId = converter.getModuleOp().lookupSymbol(mapperIdName) - ? mlir::FlatSymbolRefAttr::get(&converter.getMLIRContext(), - mapperIdName) - : mlir::FlatSymbolRefAttr(); + if (parentObj.has_value()) { + mapperId = mlir::FlatSymbolRefAttr(); + } else if (objectTypeSpec) { + std::string mapperIdName = getDefaultMapperID(objectTypeSpec); + bool needsDefaultMapper = + semantics::IsAllocatableOrObjectPointer(object.sym()) || + requiresImplicitDefaultDeclareMapper(*objectTypeSpec); + if (!mapperIdName.empty()) + mapperId = addImplicitMapper(object, mapperIdName, + /*allowGenerate=*/needsDefaultMapper); + else + mapperId = mlir::FlatSymbolRefAttr(); + } else { + mapperId = mlir::FlatSymbolRefAttr(); + } } // Explicit map captures are captured ByRef by default, diff --git a/flang/lib/Lower/OpenMP/OpenMP.cpp b/flang/lib/Lower/OpenMP/OpenMP.cpp index fe80c46c23d0..c3f670c62da0 100644 --- a/flang/lib/Lower/OpenMP/OpenMP.cpp +++ b/flang/lib/Lower/OpenMP/OpenMP.cpp @@ -2581,18 +2581,6 @@ genTargetOp(lower::AbstractConverter &converter, lower::SymMap &symTable, fir::ExtendedValue dataExv = converter.getSymbolExtendedValue(sym); name << sym.name().ToString(); - mlir::FlatSymbolRefAttr mapperId; - if (sym.GetType()->category() == semantics::DeclTypeSpec::TypeDerived) { - auto &typeSpec = sym.GetType()->derivedTypeSpec(); - std::string mapperIdName = - typeSpec.name().ToString() + llvm::omp::OmpDefaultMapperName; - if (auto *sym = converter.getCurrentScope().FindSymbol(mapperIdName)) - mapperIdName = converter.mangleName(mapperIdName, sym->owner()); - if (converter.getModuleOp().lookupSymbol(mapperIdName)) - mapperId = mlir::FlatSymbolRefAttr::get(&converter.getMLIRContext(), - mapperIdName); - } - fir::factory::AddrAndBoundsInfo info = Fortran::lower::getDataOperandBaseAddr( converter, firOpBuilder, sym.GetUltimate(), @@ -2612,6 +2600,44 @@ genTargetOp(lower::AbstractConverter &converter, lower::SymMap &symTable, mapFlagAndKind = getImplicitMapTypeAndKind( firOpBuilder, converter, defaultMaps, eleType, loc, sym); + mlir::FlatSymbolRefAttr mapperId; + if (defaultMaps.empty()) { + // TODO: Honor user-provided defaultmap clauses (aggregates/pointers) + // instead of blanket-disabling implicit mapper generation whenever any + // explicit default map is present. + const semantics::DerivedTypeSpec *typeSpec = + sym.GetType() ? sym.GetType()->AsDerived() : nullptr; + if (typeSpec) { + std::string mapperIdName = + typeSpec->name().ToString() + llvm::omp::OmpDefaultMapperName; + if (auto *mapperSym = + converter.getCurrentScope().FindSymbol(mapperIdName)) + mapperIdName = + converter.mangleName(mapperIdName, mapperSym->owner()); + else + mapperIdName = + converter.mangleName(mapperIdName, *typeSpec->GetScope()); + + if (!mapperIdName.empty()) { + bool allowImplicitMapper = + semantics::IsAllocatableOrObjectPointer(&sym); + bool hasDefaultMapper = + converter.getModuleOp().lookupSymbol(mapperIdName); + if (hasDefaultMapper || allowImplicitMapper) { + if (!hasDefaultMapper) { + if (auto recordType = mlir::dyn_cast_or_null( + converter.genType(*typeSpec))) + mapperId = getOrGenImplicitDefaultDeclareMapper( + converter, loc, recordType, mapperIdName); + } else { + mapperId = mlir::FlatSymbolRefAttr::get( + &converter.getMLIRContext(), mapperIdName); + } + } + } + } + } + mlir::Value mapOp = createMapInfoOp( firOpBuilder, converter.getCurrentLocation(), baseOp, /*varPtrPtr=*/mlir::Value{}, name.str(), bounds, /*members=*/{}, diff --git a/flang/lib/Lower/OpenMP/Utils.cpp b/flang/lib/Lower/OpenMP/Utils.cpp index 6487f599df72..eda4d0782f48 100644 --- a/flang/lib/Lower/OpenMP/Utils.cpp +++ b/flang/lib/Lower/OpenMP/Utils.cpp @@ -14,22 +14,28 @@ #include "ClauseFinder.h" #include "flang/Evaluate/fold.h" +#include "flang/Evaluate/tools.h" #include #include #include #include #include #include +#include #include #include +#include #include #include #include #include #include #include +#include +#include #include +#include #include template @@ -61,6 +67,142 @@ namespace Fortran { namespace lower { namespace omp { +mlir::FlatSymbolRefAttr getOrGenImplicitDefaultDeclareMapper( + lower::AbstractConverter &converter, mlir::Location loc, + fir::RecordType recordType, llvm::StringRef mapperNameStr) { + if (mapperNameStr.empty()) + return {}; + + if (converter.getModuleOp().lookupSymbol(mapperNameStr)) + return mlir::FlatSymbolRefAttr::get(&converter.getMLIRContext(), + mapperNameStr); + + fir::FirOpBuilder &firOpBuilder = converter.getFirOpBuilder(); + mlir::OpBuilder::InsertionGuard guard(firOpBuilder); + + firOpBuilder.setInsertionPointToStart(converter.getModuleOp().getBody()); + auto declMapperOp = mlir::omp::DeclareMapperOp::create( + firOpBuilder, loc, mapperNameStr, recordType); + auto ®ion = declMapperOp.getRegion(); + firOpBuilder.createBlock(®ion); + auto mapperArg = region.addArgument(firOpBuilder.getRefType(recordType), loc); + + auto declareOp = hlfir::DeclareOp::create(firOpBuilder, loc, mapperArg, + /*uniq_name=*/""); + + const auto genBoundsOps = [&](mlir::Value mapVal, + llvm::SmallVectorImpl &bounds) { + fir::ExtendedValue extVal = + hlfir::translateToExtendedValue(mapVal.getLoc(), firOpBuilder, + hlfir::Entity{mapVal}, + /*contiguousHint=*/true) + .first; + fir::factory::AddrAndBoundsInfo info = fir::factory::getDataOperandBaseAddr( + firOpBuilder, mapVal, /*isOptional=*/false, mapVal.getLoc()); + bounds = fir::factory::genImplicitBoundsOps( + firOpBuilder, info, extVal, + /*dataExvIsAssumedSize=*/false, mapVal.getLoc()); + }; + + const auto getFieldRef = [&](mlir::Value rec, llvm::StringRef fieldName, + mlir::Type fieldTy, mlir::Type recType) { + mlir::Value field = fir::FieldIndexOp::create( + firOpBuilder, loc, fir::FieldType::get(recType.getContext()), fieldName, + recType, fir::getTypeParams(rec)); + return fir::CoordinateOp::create( + firOpBuilder, loc, firOpBuilder.getRefType(fieldTy), rec, field); + }; + + llvm::SmallVector clauseMapVars; + llvm::SmallVector> memberPlacementIndices; + llvm::SmallVector memberMapOps; + + mlir::omp::ClauseMapFlags mapFlag = mlir::omp::ClauseMapFlags::to | + mlir::omp::ClauseMapFlags::from | + mlir::omp::ClauseMapFlags::implicit; + mlir::omp::VariableCaptureKind captureKind = + mlir::omp::VariableCaptureKind::ByRef; + + for (const auto &entry : llvm::enumerate(recordType.getTypeList())) { + const auto &memberName = entry.value().first; + const auto &memberType = entry.value().second; + mlir::FlatSymbolRefAttr mapperId; + if (auto recType = mlir::dyn_cast( + fir::getFortranElementType(memberType))) { + std::string mapperIdName = + recType.getName().str() + llvm::omp::OmpDefaultMapperName; + if (auto *sym = converter.getCurrentScope().FindSymbol(mapperIdName)) + mapperIdName = converter.mangleName(mapperIdName, sym->owner()); + else if (auto *memberSym = + converter.getCurrentScope().FindSymbol(memberName)) + mapperIdName = converter.mangleName(mapperIdName, memberSym->owner()); + + mapperId = getOrGenImplicitDefaultDeclareMapper(converter, loc, recType, + mapperIdName); + } + + auto ref = + getFieldRef(declareOp.getBase(), memberName, memberType, recordType); + llvm::SmallVector bounds; + genBoundsOps(ref, bounds); + mlir::Value mapOp = Fortran::utils::openmp::createMapInfoOp( + firOpBuilder, loc, ref, /*varPtrPtr=*/mlir::Value{}, /*name=*/"", + bounds, + /*members=*/{}, + /*membersIndex=*/mlir::ArrayAttr{}, mapFlag, captureKind, ref.getType(), + /*partialMap=*/false, mapperId); + memberMapOps.emplace_back(mapOp); + memberPlacementIndices.emplace_back( + llvm::SmallVector{(int64_t)entry.index()}); + } + + llvm::SmallVector bounds; + genBoundsOps(declareOp.getOriginalBase(), bounds); + mlir::omp::ClauseMapFlags parentMapFlag = mlir::omp::ClauseMapFlags::implicit; + mlir::omp::MapInfoOp mapOp = Fortran::utils::openmp::createMapInfoOp( + firOpBuilder, loc, declareOp.getOriginalBase(), + /*varPtrPtr=*/mlir::Value(), /*name=*/"", bounds, memberMapOps, + firOpBuilder.create2DI64ArrayAttr(memberPlacementIndices), parentMapFlag, + captureKind, declareOp.getType(0), + /*partialMap=*/true); + + clauseMapVars.emplace_back(mapOp); + mlir::omp::DeclareMapperInfoOp::create(firOpBuilder, loc, clauseMapVars); + return mlir::FlatSymbolRefAttr::get(&converter.getMLIRContext(), + mapperNameStr); +} + +bool requiresImplicitDefaultDeclareMapper( + const semantics::DerivedTypeSpec &typeSpec) { + // ISO C interoperable types (e.g., c_ptr, c_funptr) must always have implicit + // default mappers available so that OpenMP offloading can correctly map them. + if (semantics::IsIsoCType(&typeSpec)) + return true; + + llvm::SmallPtrSet visited; + + std::function requiresMapper = + [&](const semantics::DerivedTypeSpec &spec) -> bool { + if (!visited.insert(&spec).second) + return false; + + semantics::DirectComponentIterator directComponents{spec}; + for (const semantics::Symbol &component : directComponents) { + if (semantics::IsAllocatableOrPointer(component)) + return true; + + if (const semantics::DeclTypeSpec *declType = component.GetType()) + if (const auto *nested = declType->AsDerived()) + if (requiresMapper(*nested)) + return true; + } + return false; + }; + + return requiresMapper(typeSpec); +} + int64_t getCollapseValue(const List &clauses) { auto iter = llvm::find_if(clauses, [](const Clause &clause) { return clause.id == llvm::omp::Clause::OMPC_collapse; @@ -537,6 +679,12 @@ void insertChildMapInfoIntoParent( mapOperands[std::distance(mapSyms.begin(), parentIter)] .getDefiningOp()); + // Once explicit members are attached to a parent map, do not also invoke + // a declare mapper on it, otherwise the mapper would remap the same + // components leading to duplicate mappings at runtime. + if (!indices.second.memberMap.empty() && mapOp.getMapperIdAttr()) + mapOp.setMapperIdAttr(nullptr); + // NOTE: To maintain appropriate SSA ordering, we move the parent map // which will now have references to its children after the last // of its members to be generated. This is necessary when a user diff --git a/flang/lib/Lower/OpenMP/Utils.h b/flang/lib/Lower/OpenMP/Utils.h index ef1f37ac2552..2960b663b08b 100644 --- a/flang/lib/Lower/OpenMP/Utils.h +++ b/flang/lib/Lower/OpenMP/Utils.h @@ -20,6 +20,7 @@ extern llvm::cl::opt treatIndexAsSection; namespace fir { class FirOpBuilder; +class RecordType; } // namespace fir namespace Fortran { @@ -136,6 +137,13 @@ mlir::Value createParentSymAndGenIntermediateMaps( OmpMapParentAndMemberData &parentMemberIndices, llvm::StringRef asFortran, mlir::omp::ClauseMapFlags mapTypeBits); +mlir::FlatSymbolRefAttr getOrGenImplicitDefaultDeclareMapper( + Fortran::lower::AbstractConverter &converter, mlir::Location loc, + fir::RecordType recordType, llvm::StringRef mapperNameStr); + +bool requiresImplicitDefaultDeclareMapper( + const semantics::DerivedTypeSpec &typeSpec); + omp::ObjectList gatherObjectsOf(omp::Object derivedTypeMember, semantics::SemanticsContext &semaCtx); diff --git a/flang/lib/Optimizer/OpenMP/MapInfoFinalization.cpp b/flang/lib/Optimizer/OpenMP/MapInfoFinalization.cpp index 8382a481ee87..dd4c9424f7c6 100644 --- a/flang/lib/Optimizer/OpenMP/MapInfoFinalization.cpp +++ b/flang/lib/Optimizer/OpenMP/MapInfoFinalization.cpp @@ -347,10 +347,10 @@ class MapInfoFinalizationPass /// base address (BoxOffsetOp) and a MapInfoOp for it. The most /// important thing to note is that we normally move the bounds from /// the descriptor map onto the base address map. - mlir::omp::MapInfoOp genBaseAddrMap(mlir::Value descriptor, - mlir::OperandRange bounds, - mlir::omp::ClauseMapFlags mapType, - fir::FirOpBuilder &builder) { + mlir::omp::MapInfoOp + genBaseAddrMap(mlir::Value descriptor, mlir::OperandRange bounds, + mlir::omp::ClauseMapFlags mapType, fir::FirOpBuilder &builder, + mlir::FlatSymbolRefAttr mapperId = mlir::FlatSymbolRefAttr()) { mlir::Location loc = descriptor.getLoc(); mlir::Value baseAddrAddr = fir::BoxOffsetOp::create( builder, loc, descriptor, fir::BoxFieldAttr::base_addr); @@ -372,7 +372,7 @@ class MapInfoFinalizationPass mlir::omp::VariableCaptureKind::ByRef), baseAddrAddr, /*members=*/mlir::SmallVector{}, /*membersIndex=*/mlir::ArrayAttr{}, bounds, - /*mapperId*/ mlir::FlatSymbolRefAttr(), + /*mapperId=*/mapperId, /*name=*/builder.getStringAttr(""), /*partial_map=*/builder.getBoolAttr(false)); } @@ -578,6 +578,7 @@ class MapInfoFinalizationPass // from the descriptor to be used verbatim, i.e. without additional // remapping. To avoid this remapping, simply don't generate any map // information for the descriptor members. + mlir::FlatSymbolRefAttr mapperId = op.getMapperIdAttr(); if (!mapMemberUsers.empty()) { // Currently, there should only be one user per map when this pass // is executed. Either a parent map, holding the current map in its @@ -588,8 +589,8 @@ class MapInfoFinalizationPass assert(mapMemberUsers.size() == 1 && "OMPMapInfoFinalization currently only supports single users of a " "MapInfoOp"); - auto baseAddr = - genBaseAddrMap(descriptor, op.getBounds(), op.getMapType(), builder); + auto baseAddr = genBaseAddrMap(descriptor, op.getBounds(), + op.getMapType(), builder, mapperId); ParentAndPlacement mapUser = mapMemberUsers[0]; adjustMemberIndices(memberIndices, mapUser.index); llvm::SmallVector newMemberOps; @@ -602,8 +603,8 @@ class MapInfoFinalizationPass mapUser.parent.setMembersIndexAttr( builder.create2DI64ArrayAttr(memberIndices)); } else if (!isHasDeviceAddrFlag) { - auto baseAddr = - genBaseAddrMap(descriptor, op.getBounds(), op.getMapType(), builder); + auto baseAddr = genBaseAddrMap(descriptor, op.getBounds(), + op.getMapType(), builder, mapperId); newMembers.push_back(baseAddr); if (!op.getMembers().empty()) { for (auto &indices : memberIndices) @@ -635,7 +636,7 @@ class MapInfoFinalizationPass getDescriptorMapType(mapType, target)), op.getMapCaptureTypeAttr(), /*varPtrPtr=*/mlir::Value{}, newMembers, newMembersAttr, /*bounds=*/mlir::SmallVector{}, - /*mapperId*/ mlir::FlatSymbolRefAttr(), op.getNameAttr(), + /*mapperId=*/mlir::FlatSymbolRefAttr(), op.getNameAttr(), /*partial_map=*/builder.getBoolAttr(false)); op.replaceAllUsesWith(newDescParentMapOp.getResult()); op->erase(); diff --git a/flang/test/Lower/OpenMP/declare-mapper.f90 b/flang/test/Lower/OpenMP/declare-mapper.f90 index e4c010156ee3..0266365cf03c 100644 --- a/flang/test/Lower/OpenMP/declare-mapper.f90 +++ b/flang/test/Lower/OpenMP/declare-mapper.f90 @@ -165,7 +165,7 @@ subroutine declare_mapper_4 b = 20 !$omp end target - !CHECK: %{{.*}} = omp.map.info var_ptr(%{{.*}} : !fir.ref, i32) map_clauses(tofrom) capture(ByRef) mapper(@[[MY_TYPE_MAPPER]]) -> !fir.ref {name = "a%{{.*}}"} + !CHECK: %{{.*}} = omp.map.info var_ptr(%{{.*}} : !fir.ref, i32) map_clauses(tofrom) capture(ByRef) -> !fir.ref {name = "a%{{.*}}"} !$omp target map(a%num) a%num = 30 !$omp end target diff --git a/flang/test/Lower/OpenMP/derived-type-map.f90 b/flang/test/Lower/OpenMP/derived-type-map.f90 index 279cddec51fc..228e86d9e4df 100644 --- a/flang/test/Lower/OpenMP/derived-type-map.f90 +++ b/flang/test/Lower/OpenMP/derived-type-map.f90 @@ -1,5 +1,6 @@ !RUN: %flang_fc1 -emit-hlfir -fopenmp %s -o - | FileCheck %s +!CHECK: omp.declare_mapper @[[MAPPER1:_QQFmaptype_derived_implicit_allocatablescalar_and_array.omp.default.mapper]] : !fir.type<_QFmaptype_derived_implicit_allocatableTscalar_and_array{real:f32,array:!fir.array<10xi32>,int:i32}> { !CHECK: %[[ALLOCA:.*]] = fir.alloca !fir.type<_QFmaptype_derived_implicitTscalar_and_array{real:f32,array:!fir.array<10xi32>,int:i32}> {bindc_name = "scalar_arr", uniq_name = "_QFmaptype_derived_implicitEscalar_arr"} !CHECK: %[[DECLARE:.*]]:2 = hlfir.declare %[[ALLOCA]] {uniq_name = "_QFmaptype_derived_implicitEscalar_arr"} : (!fir.ref,int:i32}>>) -> (!fir.ref,int:i32}>>, !fir.ref,int:i32}>>) @@ -18,6 +19,26 @@ subroutine mapType_derived_implicit !$omp end target end subroutine mapType_derived_implicit +!CHECK: %[[ALLOCA:.*]] = fir.alloca !fir.box,int:i32}>>> {bindc_name = "scalar_arr", uniq_name = "_QFmaptype_derived_implicit_allocatableEscalar_arr"} +!CHECK: %[[DECLARE:.*]]:2 = hlfir.declare %[[ALLOCA]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFmaptype_derived_implicit_allocatableEscalar_arr"} : (!fir.ref,int:i32}>>>>) -> (!fir.ref,int:i32}>>>>, !fir.ref,int:i32}>>>>) +!CHECK: %[[BOX_ADDR:.*]] = fir.box_offset %[[DECLARE]]#1 base_addr : (!fir.ref,int:i32}>>>>) -> !fir.llvm_ptr,int:i32}>>> +!CHECK: %[[BASE_MAP:.*]] = omp.map.info var_ptr(%[[DECLARE]]#1 : !fir.ref,int:i32}>>>>, !fir.type<_QFmaptype_derived_implicit_allocatableTscalar_and_array{real:f32,array:!fir.array<10xi32>,int:i32}>) map_clauses(implicit, tofrom) capture(ByRef) var_ptr_ptr(%[[BOX_ADDR]] : !fir.llvm_ptr,int:i32}>>>) mapper(@[[MAPPER1]]) -> !fir.llvm_ptr,int:i32}>>> {name = ""} +!CHECK: %[[DESC_MAP:.*]] = omp.map.info var_ptr(%[[DECLARE]]#1 : !fir.ref,int:i32}>>>>, !fir.box,int:i32}>>>) map_clauses(implicit, to) capture(ByRef) members(%[[BASE_MAP]] : [0] : !fir.llvm_ptr,int:i32}>>>) -> !fir.ref,int:i32}>>>> {name = "scalar_arr"} +!CHECK: omp.target map_entries(%[[DESC_MAP]] -> %[[ARG0:.*]], %[[BASE_MAP]] -> %[[ARG1:.*]] : !fir.ref,int:i32}>>>>, !fir.llvm_ptr,int:i32}>>>) { +subroutine mapType_derived_implicit_allocatable + type :: scalar_and_array + real(4) :: real + integer(4) :: array(10) + integer(4) :: int + end type scalar_and_array + type(scalar_and_array), allocatable :: scalar_arr + + allocate (scalar_arr) + !$omp target + scalar_arr%int = 1 + !$omp end target +end subroutine mapType_derived_implicit_allocatable + !CHECK: %[[ALLOCA:.*]] = fir.alloca !fir.type<_QFmaptype_derived_explicitTscalar_and_array{real:f32,array:!fir.array<10xi32>,int:i32}> {bindc_name = "scalar_arr", uniq_name = "_QFmaptype_derived_explicitEscalar_arr"} !CHECK: %[[DECLARE:.*]]:2 = hlfir.declare %[[ALLOCA]] {uniq_name = "_QFmaptype_derived_explicitEscalar_arr"} : (!fir.ref,int:i32}>>) -> (!fir.ref,int:i32}>>, !fir.ref,int:i32}>>) !CHECK: %[[MAP:.*]] = omp.map.info var_ptr(%[[DECLARE]]#1 : !fir.ref,int:i32}>>, !fir.type<_QFmaptype_derived_explicitTscalar_and_array{real:f32,array:!fir.array<10xi32>,int:i32}>) map_clauses(tofrom) capture(ByRef) -> !fir.ref,int:i32}>> {name = "scalar_arr"} diff --git a/flang/test/Lower/OpenMP/target.f90 b/flang/test/Lower/OpenMP/target.f90 index ad1dd7044fc8..94907ba3ae74 100644 --- a/flang/test/Lower/OpenMP/target.f90 +++ b/flang/test/Lower/OpenMP/target.f90 @@ -529,7 +529,7 @@ subroutine omp_target_device_ptr use iso_c_binding, only : c_ptr, c_loc type(c_ptr) :: a integer, target :: b - !CHECK: %[[MAP:.*]] = omp.map.info var_ptr({{.*}}) map_clauses(tofrom) capture(ByRef) -> {{.*}} {name = "a"} + !CHECK: %[[MAP:.*]] = omp.map.info var_ptr({{.*}}) map_clauses(tofrom) capture(ByRef) mapper(@[[CPTR_DEFAULT:_QQM__fortran_builtinsc_ptr\.omp\.default\.mapper]]) -> {{.*}} {name = "a"} !CHECK: omp.target_data map_entries(%[[MAP]]{{.*}}) use_device_ptr({{.*}} -> %[[VAL_1:.*]] : !fir.ref>) !$omp target data map(tofrom: a) use_device_ptr(a) !CHECK: {{.*}} = fir.coordinate_of %[[VAL_1:.*]], __address : (!fir.ref>) -> !fir.ref diff --git a/offload/test/offloading/fortran/implicit-derived-enter-exit.f90 b/offload/test/offloading/fortran/implicit-derived-enter-exit.f90 new file mode 100644 index 000000000000..0c896e642987 --- /dev/null +++ b/offload/test/offloading/fortran/implicit-derived-enter-exit.f90 @@ -0,0 +1,65 @@ +! REQUIRES: flang, amdgpu + +! RUN: %libomptarget-compile-fortran-generic +! RUN: %libomptarget-run-generic 2>&1 | %fcheck-generic + +module enter_exit_mapper_mod + implicit none + + type :: field_type + real, allocatable :: values(:) + end type field_type + + type :: tile_type + type(field_type) :: field + integer, allocatable :: neighbors(:) + end type tile_type + +contains + subroutine init_tile(tile) + type(tile_type), intent(inout) :: tile + integer :: j + + allocate(tile%field%values(4)) + allocate(tile%neighbors(4)) + do j = 1, 4 + tile%field%values(j) = 10.0 * j + tile%neighbors(j) = j + end do + end subroutine init_tile + +end module enter_exit_mapper_mod + +program implicit_enter_exit + use enter_exit_mapper_mod + implicit none + integer :: j + type(tile_type) :: tile + + call init_tile(tile) + + !$omp target enter data map(alloc: tile%field%values) + + !$omp target + do j = 1, size(tile%field%values) + tile%field%values(j) = 5.0 * j + end do + !$omp end target + + !$omp target exit data map(from: tile%field%values) + + do j = 1, size(tile%field%values) + if (tile%field%values(j) /= 5.0 * j) then + print *, "======= Test Failed! =======" + stop 1 + end if + if (tile%neighbors(j) /= j) then + print *, "======= Test Failed! =======" + stop 1 + end if + end do + + print *, "======= Test Passed! =======" +end program implicit_enter_exit + +! CHECK: ======= Test Passed! =======