[flang-commits] [flang] [flang][Semantics][OpenMP] Check type of reduction variables (PR #94596)

via flang-commits flang-commits at lists.llvm.org
Thu Jun 6 02:34:49 PDT 2024


llvmbot wrote:


<!--LLVM PR SUMMARY COMMENT-->
@llvm/pr-subscribers-flang-semantics

@llvm/pr-subscribers-flang-fir-hlfir

Author: Tom Eccles (tblah)

<details>
<summary>Changes</summary>

Fixes #<!-- -->92440

I had to delete part of reduction09.f90 because I don't think that should have ever worked.

---
Full diff: https://github.com/llvm/llvm-project/pull/94596.diff


4 Files Affected:

- (modified) flang/lib/Semantics/check-omp-structure.cpp (+87) 
- (modified) flang/test/Lower/OpenMP/Todo/reduction-derived-type-field.f90 (+2-1) 
- (modified) flang/test/Semantics/OpenMP/reduction09.f90 (-10) 
- (added) flang/test/Semantics/OpenMP/reduction14.f90 (+97) 


``````````diff
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index 54ce45157537c..eba6da80d6264 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -2378,6 +2378,89 @@ bool OmpStructureChecker::CheckIntrinsicOperator(
   return false;
 }
 
+static bool isReductionAllowedForType(
+    const parser::OmpClause::Reduction &x, const DeclTypeSpec *type) {
+  assert(type && "no type for reduction symbol");
+  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:
+                assert(false &&
+                    "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 +2480,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, symbol->GetType())) {
+      context_.Say(source,
+          "The type of '%s' is incompatible with the reduction operator."_err_en_US,
+          symbol->name());
     }
   }
 }
diff --git a/flang/test/Lower/OpenMP/Todo/reduction-derived-type-field.f90 b/flang/test/Lower/OpenMP/Todo/reduction-derived-type-field.f90
index 8bded2fdb7469..ac6fe414d3044 100644
--- a/flang/test/Lower/OpenMP/Todo/reduction-derived-type-field.f90
+++ b/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
diff --git a/flang/test/Semantics/OpenMP/reduction09.f90 b/flang/test/Semantics/OpenMP/reduction09.f90
index 095b49ba0c400..dbc8d1b060e65 100644
--- a/flang/test/Semantics/OpenMP/reduction09.f90
+++ b/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
diff --git a/flang/test/Semantics/OpenMP/reduction14.f90 b/flang/test/Semantics/OpenMP/reduction14.f90
new file mode 100644
index 0000000000000..7d3f8d468f765
--- /dev/null
+++ b/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

``````````

</details>


https://github.com/llvm/llvm-project/pull/94596


More information about the flang-commits mailing list