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

Tom Eccles via flang-commits flang-commits at lists.llvm.org
Fri Jun 7 04:00:12 PDT 2024


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

>From a01bdee918f18664b845a352ed2a24800f40b95c Mon Sep 17 00:00:00 2001
From: Tom Eccles <tom.eccles at arm.com>
Date: Wed, 5 Jun 2024 12:59:36 +0000
Subject: [PATCH 1/3] [flang][Semantics][OpenMP] Check type of reduction
 variables

Fixes #92440

I had to delete part of reduction09.f90 because I don't think that
should have ever worked.
---
 flang/lib/Semantics/check-omp-structure.cpp   | 87 +++++++++++++++++
 .../Todo/reduction-derived-type-field.f90     |  3 +-
 flang/test/Semantics/OpenMP/reduction09.f90   | 10 --
 flang/test/Semantics/OpenMP/reduction14.f90   | 97 +++++++++++++++++++
 4 files changed, 186 insertions(+), 11 deletions(-)
 create mode 100644 flang/test/Semantics/OpenMP/reduction14.f90

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

>From 020a31030366eb1aeecd7c38c11fb5b611a90d02 Mon Sep 17 00:00:00 2001
From: Tom Eccles <tom.eccles at arm.com>
Date: Thu, 6 Jun 2024 12:40:38 +0000
Subject: [PATCH 2/3] Fix typo

---
 flang/test/Lower/OpenMP/Todo/reduction-derived-type-field.f90 | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

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 ac6fe414d3044..051f529c81316 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,7 @@
 ! 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
 
-! THere's no definition of '+' for type(t)
+! There's no definition of '+' for type(t)
 ! CHECK: The type of 'mt' is incompatible with the reduction operator.
 subroutine reduction_allocatable
   type t

>From b366aa8b8376ca56881f3055e7697203e9f56cc0 Mon Sep 17 00:00:00 2001
From: Tom Eccles <tom.eccles at arm.com>
Date: Fri, 7 Jun 2024 10:44:49 +0000
Subject: [PATCH 3/3] Fix code style comments

---
 flang/lib/Semantics/check-omp-structure.cpp | 35 ++++++++++-----------
 1 file changed, 17 insertions(+), 18 deletions(-)

diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index eba6da80d6264..a1bde10a097e1 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -2378,19 +2378,18 @@ bool OmpStructureChecker::CheckIntrinsicOperator(
   return false;
 }
 
-static bool isReductionAllowedForType(
-    const parser::OmpClause::Reduction &x, const DeclTypeSpec *type) {
-  assert(type && "no type for reduction symbol");
+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;
-  };
+  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{
@@ -2409,9 +2408,9 @@ static bool isReductionAllowedForType(
               case parser::DefinedOperator::IntrinsicOperator::Add:
                 [[fallthrough]];
               case parser::DefinedOperator::IntrinsicOperator::Subtract:
-                ok = type->IsNumeric(TypeCategory::Integer) ||
-                    type->IsNumeric(TypeCategory::Real) ||
-                    type->IsNumeric(TypeCategory::Complex);
+                ok = type.IsNumeric(TypeCategory::Integer) ||
+                    type.IsNumeric(TypeCategory::Real) ||
+                    type.IsNumeric(TypeCategory::Complex);
                 break;
 
               case parser::DefinedOperator::IntrinsicOperator::AND:
@@ -2421,12 +2420,12 @@ static bool isReductionAllowedForType(
               case parser::DefinedOperator::IntrinsicOperator::EQV:
                 [[fallthrough]];
               case parser::DefinedOperator::IntrinsicOperator::NEQV:
-                ok = isLogical(type);
+                ok = IsLogical(type);
                 break;
 
               // Reduction identifier is not in OMP5.2 Table 5.2
               default:
-                assert(false &&
+                CHECK(false &&
                     "This should have been caught in CheckIntrinsicOperator");
                 ok = false;
                 break;
@@ -2444,14 +2443,14 @@ static bool isReductionAllowedForType(
                 // 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);
+                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);
+                ok = type.IsNumeric(TypeCategory::Integer) ||
+                    type.IsNumeric(TypeCategory::Real) || IsCharacter(type);
               }
             }
           },
@@ -2480,7 +2479,7 @@ 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())) {
+    } 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());



More information about the flang-commits mailing list