[flang-commits] [flang] [flang][Semantics][OpenMP] Check type of reduction variables (PR #94596)
Tom Eccles via flang-commits
flang-commits at lists.llvm.org
Thu Jun 6 02:34:19 PDT 2024
https://github.com/tblah created https://github.com/llvm/llvm-project/pull/94596
Fixes #92440
I had to delete part of reduction09.f90 because I don't think that should have ever worked.
>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] [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
More information about the flang-commits
mailing list