diff --git a/flang/lib/Lower/OpenMP/OpenMP.cpp b/flang/lib/Lower/OpenMP/OpenMP.cpp index ad456d89bc432..4429a9a94ed3c 100644 --- a/flang/lib/Lower/OpenMP/OpenMP.cpp +++ b/flang/lib/Lower/OpenMP/OpenMP.cpp @@ -1008,9 +1008,7 @@ getImplicitMapTypeAndKind(fir::FirOpBuilder &firOpBuilder, mlir::omp::VariableCaptureKind::ByRef); break; case DefMap::ImplicitBehavior::Firstprivate: - case DefMap::ImplicitBehavior::None: - TODO(loc, "Firstprivate and None are currently unsupported defaultmap " - "behaviour"); + TODO(loc, "Firstprivate is currently unsupported defaultmap behaviour"); break; case DefMap::ImplicitBehavior::From: return std::make_pair(mapFlag |= mlir::omp::ClauseMapFlags::from, @@ -1032,8 +1030,9 @@ getImplicitMapTypeAndKind(fir::FirOpBuilder &firOpBuilder, mlir::omp::VariableCaptureKind::ByRef); break; case DefMap::ImplicitBehavior::Default: + case DefMap::ImplicitBehavior::None: llvm_unreachable( - "Implicit None Behaviour Should Have Been Handled Earlier"); + "Implicit None and Default behaviour should have been handled earlier"); break; } diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp index deb57e005a352..224c69163b85e 100644 --- a/flang/lib/Semantics/resolve-directives.cpp +++ b/flang/lib/Semantics/resolve-directives.cpp @@ -2965,6 +2965,67 @@ void OmpAttributeVisitor::CreateImplicitSymbols(const Symbol *symbol) { } } +static bool IsOpenMPPointer(const Symbol &symbol) { + if (IsPointer(symbol) || IsBuiltinCPtr(symbol)) + return true; + return false; +} + +static bool IsOpenMPAggregate(const Symbol &symbol) { + if (IsAllocatable(symbol) || IsOpenMPPointer(symbol)) + return false; + + const auto *type{symbol.GetType()}; + // OpenMP categorizes Fortran characters as aggregates. + if (type->category() == Fortran::semantics::DeclTypeSpec::Category::Character) + return true; + + if (const auto *det{symbol.GetUltimate() + .detailsIf()}) + if (det->IsArray()) + return true; + + if (type->AsDerived()) + return true; + + if (IsDeferredShape(symbol) || IsAssumedRank(symbol) || + IsAssumedShape(symbol)) + return true; + return false; +} + +static bool IsOpenMPScalar(const Symbol &symbol) { + if (IsOpenMPAggregate(symbol) || IsOpenMPPointer(symbol) || + IsAllocatable(symbol)) + return false; + const auto *type{symbol.GetType()}; + if ((!symbol.GetShape() || symbol.GetShape()->empty()) && + (type->category() == + Fortran::semantics::DeclTypeSpec::Category::Numeric || + type->category() == + Fortran::semantics::DeclTypeSpec::Category::Logical)) + return true; + return false; +} + +static bool DefaultMapCategoryMatchesSymbol( + parser::OmpVariableCategory::Value category, const Symbol &symbol) { + using VarCat = parser::OmpVariableCategory::Value; + switch (category) { + case VarCat::Scalar: + return IsOpenMPScalar(symbol); + case VarCat::Allocatable: + return IsAllocatable(symbol); + case VarCat::Aggregate: + return IsOpenMPAggregate(symbol); + case VarCat::Pointer: + return IsOpenMPPointer(symbol); + case VarCat::All: + return true; + } + return false; +} + // For OpenMP constructs, check all the data-refs within the constructs // and adjust the symbol for each Name if necessary void OmpAttributeVisitor::Post(const parser::Name &name) { @@ -3000,6 +3061,36 @@ void OmpAttributeVisitor::Post(const parser::Name &name) { } } + // TODO: handle case where default and defaultmap are present on the same + // construct and conflict, defaultmap should supersede default if they + // conflict. + if (!GetContext().defaultMap.empty()) { + // Checked before implicit data sharing attributes as this rule ignores + // them and expects explicit predetermined/specified attributes to be in + // place for the types specified. + if (Symbol * found{currScope().FindSymbol(name.source)}) { + // If the variable has declare target applied to it (enter or link) it + // is exempt from defaultmap(none) restrictions + if (!symbol->GetUltimate().test(Symbol::Flag::OmpDeclareTarget)) { + auto &dMap = GetContext().defaultMap; + for (auto defaults : dMap) { + if (defaults.second == + parser::OmpDefaultmapClause::ImplicitBehavior::None) { + if (DefaultMapCategoryMatchesSymbol(defaults.first, *found)) { + if (!IsObjectWithDSA(*symbol)) { + context_.Say(name.source, + "The DEFAULTMAP(NONE) clause requires that '%s' must be " + "listed in a " + "data-sharing attribute, data-mapping attribute, or is_device_ptr clause"_err_en_US, + symbol->name()); + } + } + } + } + } + } + } + if (Symbol * found{currScope().FindSymbol(name.source)}) { if (found->GetUltimate().test(semantics::Symbol::Flag::OmpThreadprivate)) return; diff --git a/flang/test/Lower/OpenMP/Todo/defaultmap-clause-firstprivate.f90 b/flang/test/Lower/OpenMP/Todo/defaultmap-clause-firstprivate.f90 index 6818c39f63a3c..1e0d9694258cc 100644 --- a/flang/test/Lower/OpenMP/Todo/defaultmap-clause-firstprivate.f90 +++ b/flang/test/Lower/OpenMP/Todo/defaultmap-clause-firstprivate.f90 @@ -6,7 +6,7 @@ subroutine f00 ! NOTE: This is implemented for scalars as it is the default behaviour, so we utilise ! a different data type. integer, allocatable :: i - !CHECK: not yet implemented: Firstprivate and None are currently unsupported defaultmap behaviour + !CHECK: not yet implemented: Firstprivate is currently unsupported defaultmap behaviour !$omp target defaultmap(firstprivate) i = 10 !$omp end target diff --git a/flang/test/Lower/OpenMP/Todo/defaultmap-clause-none.f90 b/flang/test/Lower/OpenMP/Todo/defaultmap-clause-none.f90 deleted file mode 100644 index 287eb4a9dfe8f..0000000000000 --- a/flang/test/Lower/OpenMP/Todo/defaultmap-clause-none.f90 +++ /dev/null @@ -1,11 +0,0 @@ -!RUN: %not_todo_cmd bbc -emit-hlfir -fopenmp -fopenmp-version=51 -o - %s 2>&1 | FileCheck %s -!RUN: %not_todo_cmd %flang_fc1 -emit-hlfir -fopenmp -fopenmp-version=51 -o - %s 2>&1 | FileCheck %s - -subroutine f00 - implicit none - integer :: i - !CHECK: not yet implemented: Firstprivate and None are currently unsupported defaultmap behaviour - !$omp target defaultmap(none) - i = 10 - !$omp end target -end diff --git a/flang/test/Semantics/OpenMP/defaultmap-clause-none.f90 b/flang/test/Semantics/OpenMP/defaultmap-clause-none.f90 new file mode 100644 index 0000000000000..08e8ebc995097 --- /dev/null +++ b/flang/test/Semantics/OpenMP/defaultmap-clause-none.f90 @@ -0,0 +1,96 @@ +! RUN: %python %S/../test_errors.py %s %flang -fopenmp -fopenmp-version=51 + +subroutine defaultmap_all_none_no_errors + implicit none + real :: array(10) + integer, pointer :: ptr(:) + real, allocatable :: alloca + integer :: index + + !$omp target defaultmap(none) map(to: index, alloca) map(tofrom: array, ptr) + do index = 1, 10 + ptr(index) = array(index) + alloca + end do + !$omp end target +end subroutine defaultmap_all_none_no_errors + +subroutine defaultmap_all_none + implicit none + real :: array(10) + integer, pointer :: ptr(:) + real, allocatable :: alloca + integer :: index + !$omp target defaultmap(none) +!ERROR: The DEFAULTMAP(NONE) clause requires that 'index' must be listed in a data-sharing attribute, data-mapping attribute, or is_device_ptr clause + do index = 1, 10 +!ERROR: The DEFAULTMAP(NONE) clause requires that 'ptr' must be listed in a data-sharing attribute, data-mapping attribute, or is_device_ptr clause +!ERROR: The DEFAULTMAP(NONE) clause requires that 'index' must be listed in a data-sharing attribute, data-mapping attribute, or is_device_ptr clause +!ERROR: The DEFAULTMAP(NONE) clause requires that 'array' must be listed in a data-sharing attribute, data-mapping attribute, or is_device_ptr clause +!ERROR: The DEFAULTMAP(NONE) clause requires that 'index' must be listed in a data-sharing attribute, data-mapping attribute, or is_device_ptr clause +!ERROR: The DEFAULTMAP(NONE) clause requires that 'alloca' must be listed in a data-sharing attribute, data-mapping attribute, or is_device_ptr clause + ptr(index) = array(index) + alloca + end do + !$omp end target +end subroutine defaultmap_all_none + +subroutine defaultmap_scalar_none + implicit none + real :: array(10) + integer, pointer :: ptr(:) + real, allocatable :: alloca + integer :: index + + !$omp target defaultmap(none: scalar) +!ERROR: The DEFAULTMAP(NONE) clause requires that 'index' must be listed in a data-sharing attribute, data-mapping attribute, or is_device_ptr clause + do index = 1, 10 +!ERROR: The DEFAULTMAP(NONE) clause requires that 'index' must be listed in a data-sharing attribute, data-mapping attribute, or is_device_ptr clause +!ERROR: The DEFAULTMAP(NONE) clause requires that 'index' must be listed in a data-sharing attribute, data-mapping attribute, or is_device_ptr clause + ptr(index) = array(index) + alloca + end do + !$omp end target +end subroutine defaultmap_scalar_none + +subroutine defaultmap_pointer_none + implicit none + real :: array(10) + integer, pointer :: ptr(:) + real, allocatable :: alloca + integer :: index + + !$omp target defaultmap(none: pointer) + do index = 1, 10 +!ERROR: The DEFAULTMAP(NONE) clause requires that 'ptr' must be listed in a data-sharing attribute, data-mapping attribute, or is_device_ptr clause + ptr(index) = array(index) + alloca + end do + !$omp end target +end subroutine defaultmap_pointer_none + +subroutine defaultmap_allocatable_none + implicit none + real :: array(10) + integer, pointer :: ptr(:) + real, allocatable :: alloca + integer :: index + + !$omp target defaultmap(none: allocatable) + do index = 1, 10 +!ERROR: The DEFAULTMAP(NONE) clause requires that 'alloca' must be listed in a data-sharing attribute, data-mapping attribute, or is_device_ptr clause + ptr(index) = array(index) + alloca + end do + !$omp end target +end subroutine defaultmap_allocatable_none + +subroutine defaultmap_aggregate_none + implicit none + real :: array(10) + integer, pointer :: ptr(:) + real, allocatable :: alloca + integer :: index + + !$omp target defaultmap(none: aggregate) + do index = 1, 10 +!ERROR: The DEFAULTMAP(NONE) clause requires that 'array' must be listed in a data-sharing attribute, data-mapping attribute, or is_device_ptr clause + ptr(index) = array(index) + alloca + end do + !$omp end target +end subroutine defaultmap_aggregate_none