[Flang][OpenMP] Initial defaultmap(none) implementation

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;
   }
 

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<Fortran::semantics::ObjectEntityDetails>()})
+    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;

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

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