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

Fixes #92440

I had to delete part of reduction09.f90 because I don't think that
should have ever worked.
This commit is contained in:
Tom Eccles
2024-06-13 10:04:22 +01:00
committed by GitHub
parent 71a5b37cc0
commit f44023980d
4 changed files with 184 additions and 11 deletions

View File

@@ -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());
}
}
}

View File

@@ -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

View File

@@ -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

View File

@@ -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