Skip to content

Commit f440239

Browse files
tblahtblah
authored
[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.
1 parent 71a5b37 commit f440239

File tree

4 files changed

+184
-11
lines changed

4 files changed

+184
-11
lines changed

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

Lines changed: 85 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2378,6 +2378,87 @@ bool OmpStructureChecker::CheckIntrinsicOperator(
23782378
return false;
23792379
}
23802380

2381+
static bool IsReductionAllowedForType(
2382+
const parser::OmpClause::Reduction &x, const DeclTypeSpec &type) {
2383+
const auto &definedOp{std::get<parser::OmpReductionOperator>(x.v.t)};
2384+
// TODO: user defined reduction operators. Just allow everything for now.
2385+
bool ok{true};
2386+
2387+
auto IsLogical{[](const DeclTypeSpec &type) -> bool {
2388+
return type.category() == DeclTypeSpec::Logical;
2389+
}};
2390+
auto IsCharacter{[](const DeclTypeSpec &type) -> bool {
2391+
return type.category() == DeclTypeSpec::Character;
2392+
}};
2393+
2394+
common::visit(
2395+
common::visitors{
2396+
[&](const parser::DefinedOperator &dOpr) {
2397+
if (const auto *intrinsicOp{
2398+
std::get_if<parser::DefinedOperator::IntrinsicOperator>(
2399+
&dOpr.u)}) {
2400+
// OMP5.2: The type [...] of a list item that appears in a
2401+
// reduction clause must be valid for the combiner expression
2402+
// See F2023: Table 10.2
2403+
// .LT., .LE., .GT., .GE. are handled as procedure designators
2404+
// below.
2405+
switch (*intrinsicOp) {
2406+
case parser::DefinedOperator::IntrinsicOperator::Multiply:
2407+
[[fallthrough]];
2408+
case parser::DefinedOperator::IntrinsicOperator::Add:
2409+
[[fallthrough]];
2410+
case parser::DefinedOperator::IntrinsicOperator::Subtract:
2411+
ok = type.IsNumeric(TypeCategory::Integer) ||
2412+
type.IsNumeric(TypeCategory::Real) ||
2413+
type.IsNumeric(TypeCategory::Complex);
2414+
break;
2415+
2416+
case parser::DefinedOperator::IntrinsicOperator::AND:
2417+
[[fallthrough]];
2418+
case parser::DefinedOperator::IntrinsicOperator::OR:
2419+
[[fallthrough]];
2420+
case parser::DefinedOperator::IntrinsicOperator::EQV:
2421+
[[fallthrough]];
2422+
case parser::DefinedOperator::IntrinsicOperator::NEQV:
2423+
ok = IsLogical(type);
2424+
break;
2425+
2426+
// Reduction identifier is not in OMP5.2 Table 5.2
2427+
default:
2428+
DIE("This should have been caught in CheckIntrinsicOperator");
2429+
ok = false;
2430+
break;
2431+
}
2432+
}
2433+
},
2434+
[&](const parser::ProcedureDesignator &procD) {
2435+
const parser::Name *name{std::get_if<parser::Name>(&procD.u)};
2436+
if (name && name->symbol) {
2437+
const SourceName &realName{name->symbol->GetUltimate().name()};
2438+
// OMP5.2: The type [...] of a list item that appears in a
2439+
// reduction clause must be valid for the combiner expression
2440+
if (realName == "iand" || realName == "ior" ||
2441+
realName == "ieor") {
2442+
// IAND: arguments must be integers: F2023 16.9.100
2443+
// IEOR: arguments must be integers: F2023 16.9.106
2444+
// IOR: arguments must be integers: F2023 16.9.111
2445+
ok = type.IsNumeric(TypeCategory::Integer);
2446+
} else if (realName == "max" || realName == "min") {
2447+
// MAX: arguments must be integer, real, or character:
2448+
// F2023 16.9.135
2449+
// MIN: arguments must be integer, real, or character:
2450+
// F2023 16.9.141
2451+
ok = type.IsNumeric(TypeCategory::Integer) ||
2452+
type.IsNumeric(TypeCategory::Real) || IsCharacter(type);
2453+
}
2454+
}
2455+
},
2456+
},
2457+
definedOp.u);
2458+
2459+
return ok;
2460+
}
2461+
23812462
void OmpStructureChecker::CheckReductionTypeList(
23822463
const parser::OmpClause::Reduction &x) {
23832464
const auto &ompObjectList{std::get<parser::OmpObjectList>(x.v.t)};
@@ -2397,6 +2478,10 @@ void OmpStructureChecker::CheckReductionTypeList(
23972478
context_.Say(source,
23982479
"A procedure pointer '%s' must not appear in a REDUCTION clause."_err_en_US,
23992480
symbol->name());
2481+
} else if (!IsReductionAllowedForType(x, DEREF(symbol->GetType()))) {
2482+
context_.Say(source,
2483+
"The type of '%s' is incompatible with the reduction operator."_err_en_US,
2484+
symbol->name());
24002485
}
24012486
}
24022487
}

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

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,8 @@
11
! RUN: %not_todo_cmd bbc -emit-fir -fopenmp -o - %s 2>&1 | FileCheck %s
22
! RUN: %not_todo_cmd %flang_fc1 -emit-fir -fopenmp -o - %s 2>&1 | FileCheck %s
33

4-
! CHECK: not yet implemented: Reduction of some types is not supported
4+
! There's no definition of '+' for type(t)
5+
! CHECK: The type of 'mt' is incompatible with the reduction operator.
56
subroutine reduction_allocatable
67
type t
78
integer :: x

‎flang/test/Semantics/OpenMP/reduction09.f90

Lines changed: 0 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -73,14 +73,4 @@ program omp_reduction
7373
k = k+1
7474
end do
7575
!$omp end do
76-
77-
78-
!$omp do reduction(.and.:k) reduction(.or.:j) reduction(.eqv.:l)
79-
!DEF: /omp_reduction/OtherConstruct8/i (OmpPrivate, OmpPreDetermined) HostAssoc INTEGER(4)
80-
do i=1,10
81-
!DEF: /omp_reduction/OtherConstruct8/k (OmpReduction) HostAssoc INTEGER(4)
82-
k = k+1
83-
end do
84-
!$omp end do
85-
8676
end program omp_reduction

‎flang/test/Semantics/OpenMP/reduction14.f90

Lines changed: 97 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,97 @@
1+
! RUN: %python %S/../test_errors.py %s %flang_fc1 -fopenmp
2+
! OpenMP Version 4.5
3+
! 2.15.3.6 Reduction Clause
4+
program omp_reduction
5+
integer :: i
6+
real :: r
7+
character :: c
8+
complex :: z
9+
logical :: l
10+
11+
! * is allowed for integer, real, and complex
12+
! but not for logical or character
13+
! ERROR: The type of 'c' is incompatible with the reduction operator.
14+
! ERROR: The type of 'l' is incompatible with the reduction operator.
15+
!$omp parallel reduction(*:i,r,c,z,l)
16+
!$omp end parallel
17+
18+
! + is allowed for integer, real, and complex
19+
! but not for logical or character
20+
! ERROR: The type of 'c' is incompatible with the reduction operator.
21+
! ERROR: The type of 'l' is incompatible with the reduction operator.
22+
!$omp parallel reduction(+:i,r,c,z,l)
23+
!$omp end parallel
24+
25+
! - is deprecated for all types
26+
! ERROR: The minus reduction operator is deprecated since OpenMP 5.2 and is not supported in the REDUCTION clause.
27+
!$omp parallel reduction(-:i,r,c,z,l)
28+
!$omp end parallel
29+
30+
! .and. is only supported for logical operations
31+
! ERROR: The type of 'i' is incompatible with the reduction operator.
32+
! ERROR: The type of 'r' is incompatible with the reduction operator.
33+
! ERROR: The type of 'c' is incompatible with the reduction operator.
34+
! ERROR: The type of 'z' is incompatible with the reduction operator.
35+
!$omp parallel reduction(.and.:i,r,c,z,l)
36+
!$omp end parallel
37+
38+
! .or. is only supported for logical operations
39+
! ERROR: The type of 'i' is incompatible with the reduction operator.
40+
! ERROR: The type of 'r' is incompatible with the reduction operator.
41+
! ERROR: The type of 'c' is incompatible with the reduction operator.
42+
! ERROR: The type of 'z' is incompatible with the reduction operator.
43+
!$omp parallel reduction(.or.:i,r,c,z,l)
44+
!$omp end parallel
45+
46+
! .eqv. is only supported for logical operations
47+
! ERROR: The type of 'i' is incompatible with the reduction operator.
48+
! ERROR: The type of 'r' is incompatible with the reduction operator.
49+
! ERROR: The type of 'c' is incompatible with the reduction operator.
50+
! ERROR: The type of 'z' is incompatible with the reduction operator.
51+
!$omp parallel reduction(.eqv.:i,r,c,z,l)
52+
!$omp end parallel
53+
54+
! .neqv. is only supported for logical operations
55+
! ERROR: The type of 'i' is incompatible with the reduction operator.
56+
! ERROR: The type of 'r' is incompatible with the reduction operator.
57+
! ERROR: The type of 'c' is incompatible with the reduction operator.
58+
! ERROR: The type of 'z' is incompatible with the reduction operator.
59+
!$omp parallel reduction(.neqv.:i,r,c,z,l)
60+
!$omp end parallel
61+
62+
! iand only supports integers
63+
! ERROR: The type of 'r' is incompatible with the reduction operator.
64+
! ERROR: The type of 'c' is incompatible with the reduction operator.
65+
! ERROR: The type of 'z' is incompatible with the reduction operator.
66+
! ERROR: The type of 'l' is incompatible with the reduction operator.
67+
!$omp parallel reduction(iand:i,r,c,z,l)
68+
!$omp end parallel
69+
70+
! ior only supports integers
71+
! ERROR: The type of 'r' is incompatible with the reduction operator.
72+
! ERROR: The type of 'c' is incompatible with the reduction operator.
73+
! ERROR: The type of 'z' is incompatible with the reduction operator.
74+
! ERROR: The type of 'l' is incompatible with the reduction operator.
75+
!$omp parallel reduction(ior:i,r,c,z,l)
76+
!$omp end parallel
77+
78+
! ieor only supports integers
79+
! ERROR: The type of 'r' is incompatible with the reduction operator.
80+
! ERROR: The type of 'c' is incompatible with the reduction operator.
81+
! ERROR: The type of 'z' is incompatible with the reduction operator.
82+
! ERROR: The type of 'l' is incompatible with the reduction operator.
83+
!$omp parallel reduction(ieor:i,r,c,z,l)
84+
!$omp end parallel
85+
86+
! max arguments may be integer, real, or character:
87+
! ERROR: The type of 'z' is incompatible with the reduction operator.
88+
! ERROR: The type of 'l' is incompatible with the reduction operator.
89+
!$omp parallel reduction(max:i,r,c,z,l)
90+
!$omp end parallel
91+
92+
! min arguments may be integer, real, or character:
93+
! ERROR: The type of 'z' is incompatible with the reduction operator.
94+
! ERROR: The type of 'l' is incompatible with the reduction operator.
95+
!$omp parallel reduction(min:i,r,c,z,l)
96+
!$omp end parallel
97+
end program omp_reduction

0 commit comments

Comments
 (0)