diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp index e85d8d1f7ab53..c22380f4fed85 100644 --- a/flang/lib/Semantics/check-omp-structure.cpp +++ b/flang/lib/Semantics/check-omp-structure.cpp @@ -2286,6 +2286,7 @@ void OmpStructureChecker::Enter(const parser::OmpClause::Reduction &x) { CheckReductionTypeList(x); } } + bool OmpStructureChecker::CheckReductionOperators( const parser::OmpClause::Reduction &x) { @@ -2356,6 +2357,16 @@ void OmpStructureChecker::CheckReductionTypeList( if (llvm::omp::nestedReduceWorkshareAllowedSet.test(GetContext().directive)) { CheckSharedBindingInOuterContext(ompObjectList); } + + SymbolSourceMap symbols; + GetSymbolsInObjectList(ompObjectList, symbols); + for (auto &[symbol, source] : symbols) { + if (IsProcedurePointer(*symbol)) { + context_.Say(source, + "A procedure pointer '%s' must not appear in a REDUCTION clause."_err_en_US, + symbol->name()); + } + } } void OmpStructureChecker::CheckIntentInPointerAndDefinable( diff --git a/flang/test/Semantics/OpenMP/reduction12.f90 b/flang/test/Semantics/OpenMP/reduction12.f90 new file mode 100644 index 0000000000000..f896ca4aa60b6 --- /dev/null +++ b/flang/test/Semantics/OpenMP/reduction12.f90 @@ -0,0 +1,16 @@ +! RUN: %python %S/../test_errors.py %s %flang_fc1 -fopenmp + +! OpenMP 5.2: Section 5.5.5 : A procedure pointer must not appear in a +! reduction clause. + + procedure(foo), pointer :: ptr + integer :: i + ptr => foo +!ERROR: A procedure pointer 'ptr' must not appear in a REDUCTION clause. +!$omp do reduction (+ : ptr) + do i = 1, 10 + end do +contains + subroutine foo + end subroutine +end