[flang][Semantics][OpenMP] Check type of reduction variables

flang/lib/Semantics/check-omp-structure.cpp

@@ -2378,6 +2378,87 @@ bool OmpStructureChecker::CheckIntrinsicOperator(
   return false;
 }
 
+static bool IsReductionAllowedForType(
+    const parser::OmpClause::Reduction &x, const DeclTypeSpec &type) {
+  const auto &definedOp{std::get<parser::OmpReductionOperator>(x.v.t)};
+  // TODO: user defined reduction operators. Just allow everything for now.
+  bool ok{true};
+
+  auto IsLogical{[](const DeclTypeSpec &type) -> bool {
+    return type.category() == DeclTypeSpec::Logical;
+  }};
+  auto IsCharacter{[](const DeclTypeSpec &type) -> bool {
+    return type.category() == DeclTypeSpec::Character;
+  }};
+
+  common::visit(
+      common::visitors{
+          [&](const parser::DefinedOperator &dOpr) {
+            if (const auto *intrinsicOp{
+                    std::get_if<parser::DefinedOperator::IntrinsicOperator>(
+                        &dOpr.u)}) {
+              // OMP5.2: The type [...] of a list item that appears in a
+              // reduction clause must be valid for the combiner expression
+              // See F2023: Table 10.2
+              // .LT., .LE., .GT., .GE. are handled as procedure designators
+              // below.
+              switch (*intrinsicOp) {
+              case parser::DefinedOperator::IntrinsicOperator::Multiply:
+                [[fallthrough]];
+              case parser::DefinedOperator::IntrinsicOperator::Add:
+                [[fallthrough]];
+              case parser::DefinedOperator::IntrinsicOperator::Subtract:
+                ok = type.IsNumeric(TypeCategory::Integer) ||
+                    type.IsNumeric(TypeCategory::Real) ||
+                    type.IsNumeric(TypeCategory::Complex);
+                break;
+
+              case parser::DefinedOperator::IntrinsicOperator::AND:
+                [[fallthrough]];
+              case parser::DefinedOperator::IntrinsicOperator::OR:
+                [[fallthrough]];
+              case parser::DefinedOperator::IntrinsicOperator::EQV:
+                [[fallthrough]];
+              case parser::DefinedOperator::IntrinsicOperator::NEQV:
+                ok = IsLogical(type);
+                break;
+
+              // Reduction identifier is not in OMP5.2 Table 5.2
+              default:
+                DIE("This should have been caught in CheckIntrinsicOperator");
+                ok = false;
+                break;
+              }
+            }
+          },
+          [&](const parser::ProcedureDesignator &procD) {
+            const parser::Name *name{std::get_if<parser::Name>(&procD.u)};
+            if (name && name->symbol) {
+              const SourceName &realName{name->symbol->GetUltimate().name()};
+              // OMP5.2: The type [...] of a list item that appears in a
+              // reduction clause must be valid for the combiner expression
+              if (realName == "iand" || realName == "ior" ||
+                  realName == "ieor") {
+                // IAND: arguments must be integers: F2023 16.9.100
+                // IEOR: arguments must be integers: F2023 16.9.106
+                // IOR: arguments must be integers: F2023 16.9.111
+                ok = type.IsNumeric(TypeCategory::Integer);
+              } else if (realName == "max" || realName == "min") {
+                // MAX: arguments must be integer, real, or character:
+                // F2023 16.9.135
+                // MIN: arguments must be integer, real, or character:
+                // F2023 16.9.141
+                ok = type.IsNumeric(TypeCategory::Integer) ||
+                    type.IsNumeric(TypeCategory::Real) || IsCharacter(type);
+              }
+            }
+          },
+      },
+      definedOp.u);
+
+  return ok;
+}
+
 void OmpStructureChecker::CheckReductionTypeList(
     const parser::OmpClause::Reduction &x) {
   const auto &ompObjectList{std::get<parser::OmpObjectList>(x.v.t)};
@@ -2397,6 +2478,10 @@ void OmpStructureChecker::CheckReductionTypeList(
       context_.Say(source,
           "A procedure pointer '%s' must not appear in a REDUCTION clause."_err_en_US,
           symbol->name());
+    } else if (!IsReductionAllowedForType(x, DEREF(symbol->GetType()))) {
+      context_.Say(source,
+          "The type of '%s' is incompatible with the reduction operator."_err_en_US,
+          symbol->name());
     }
   }
 }

flang/test/Lower/OpenMP/Todo/reduction-derived-type-field.f90

@@ -1,7 +1,8 @@
 ! RUN: %not_todo_cmd bbc -emit-fir -fopenmp -o - %s 2>&1 | FileCheck %s
 ! RUN: %not_todo_cmd %flang_fc1 -emit-fir -fopenmp -o - %s 2>&1 | FileCheck %s
 
-! CHECK: not yet implemented: Reduction of some types is not supported
+! There's no definition of '+' for type(t)
+! CHECK: The type of 'mt' is incompatible with the reduction operator.
 subroutine reduction_allocatable
   type t
     integer :: x

flang/test/Semantics/OpenMP/reduction09.f90

@@ -73,14 +73,4 @@ program omp_reduction
     k = k+1
   end do
   !$omp end do
-
-
-  !$omp do reduction(.and.:k) reduction(.or.:j) reduction(.eqv.:l)
-  !DEF: /omp_reduction/OtherConstruct8/i (OmpPrivate, OmpPreDetermined) HostAssoc INTEGER(4)
-  do i=1,10
-    !DEF: /omp_reduction/OtherConstruct8/k (OmpReduction) HostAssoc INTEGER(4)
-    k = k+1
-  end do
-  !$omp end do
-
 end program omp_reduction

flang/test/Semantics/OpenMP/reduction14.f90

@@ -0,0 +1,97 @@
+! RUN: %python %S/../test_errors.py %s %flang_fc1 -fopenmp
+! OpenMP Version 4.5
+! 2.15.3.6 Reduction Clause
+program omp_reduction
+  integer :: i
+  real :: r
+  character :: c
+  complex :: z
+  logical :: l
+
+  ! * is allowed for integer, real, and complex
+  ! but not for logical or character
+  ! ERROR: The type of 'c' is incompatible with the reduction operator.
+  ! ERROR: The type of 'l' is incompatible with the reduction operator.
+  !$omp parallel reduction(*:i,r,c,z,l)
+  !$omp end parallel
+
+  ! + is allowed for integer, real, and complex
+  ! but not for logical or character
+  ! ERROR: The type of 'c' is incompatible with the reduction operator.
+  ! ERROR: The type of 'l' is incompatible with the reduction operator.
+  !$omp parallel reduction(+:i,r,c,z,l)
+  !$omp end parallel
+
+  ! - is deprecated for all types
+  ! ERROR: The minus reduction operator is deprecated since OpenMP 5.2 and is not supported in the REDUCTION clause.
+  !$omp parallel reduction(-:i,r,c,z,l)
+  !$omp end parallel
+
+  ! .and. is only supported for logical operations
+  ! ERROR: The type of 'i' is incompatible with the reduction operator.
+  ! ERROR: The type of 'r' is incompatible with the reduction operator.
+  ! ERROR: The type of 'c' is incompatible with the reduction operator.
+  ! ERROR: The type of 'z' is incompatible with the reduction operator.
+  !$omp parallel reduction(.and.:i,r,c,z,l)
+  !$omp end parallel
+
+  ! .or. is only supported for logical operations
+  ! ERROR: The type of 'i' is incompatible with the reduction operator.
+  ! ERROR: The type of 'r' is incompatible with the reduction operator.
+  ! ERROR: The type of 'c' is incompatible with the reduction operator.
+  ! ERROR: The type of 'z' is incompatible with the reduction operator.
+  !$omp parallel reduction(.or.:i,r,c,z,l)
+  !$omp end parallel
+
+  ! .eqv. is only supported for logical operations
+  ! ERROR: The type of 'i' is incompatible with the reduction operator.
+  ! ERROR: The type of 'r' is incompatible with the reduction operator.
+  ! ERROR: The type of 'c' is incompatible with the reduction operator.
+  ! ERROR: The type of 'z' is incompatible with the reduction operator.
+  !$omp parallel reduction(.eqv.:i,r,c,z,l)
+  !$omp end parallel
+
+  ! .neqv. is only supported for logical operations
+  ! ERROR: The type of 'i' is incompatible with the reduction operator.
+  ! ERROR: The type of 'r' is incompatible with the reduction operator.
+  ! ERROR: The type of 'c' is incompatible with the reduction operator.
+  ! ERROR: The type of 'z' is incompatible with the reduction operator.
+  !$omp parallel reduction(.neqv.:i,r,c,z,l)
+  !$omp end parallel
+
+  ! iand only supports integers
+  ! ERROR: The type of 'r' is incompatible with the reduction operator.
+  ! ERROR: The type of 'c' is incompatible with the reduction operator.
+  ! ERROR: The type of 'z' is incompatible with the reduction operator.
+  ! ERROR: The type of 'l' is incompatible with the reduction operator.
+  !$omp parallel reduction(iand:i,r,c,z,l)
+  !$omp end parallel
+
+  ! ior only supports integers
+  ! ERROR: The type of 'r' is incompatible with the reduction operator.
+  ! ERROR: The type of 'c' is incompatible with the reduction operator.
+  ! ERROR: The type of 'z' is incompatible with the reduction operator.
+  ! ERROR: The type of 'l' is incompatible with the reduction operator.
+  !$omp parallel reduction(ior:i,r,c,z,l)
+  !$omp end parallel
+
+  ! ieor only supports integers
+  ! ERROR: The type of 'r' is incompatible with the reduction operator.
+  ! ERROR: The type of 'c' is incompatible with the reduction operator.
+  ! ERROR: The type of 'z' is incompatible with the reduction operator.
+  ! ERROR: The type of 'l' is incompatible with the reduction operator.
+  !$omp parallel reduction(ieor:i,r,c,z,l)
+  !$omp end parallel
+
+  ! max arguments may be integer, real, or character:
+  ! ERROR: The type of 'z' is incompatible with the reduction operator.
+  ! ERROR: The type of 'l' is incompatible with the reduction operator.
+  !$omp parallel reduction(max:i,r,c,z,l)
+  !$omp end parallel
+
+  ! min arguments may be integer, real, or character:
+  ! ERROR: The type of 'z' is incompatible with the reduction operator.
+  ! ERROR: The type of 'l' is incompatible with the reduction operator.
+  !$omp parallel reduction(min:i,r,c,z,l)
+  !$omp end parallel
+end program omp_reduction