[flang-commits] [flang] b3c72bc - [Flang][OpenMP] Issue error if reduction clause has proc-pointer (#88999)

[via flang-commits]

Author: Kiran Chandramohan
Date: 2024-04-19T12:47:31+01:00
New Revision: b3c72bcbf2eb7963ef0ac3da519107aba151f77f

URL: https://github.com/llvm/llvm-project/commit/b3c72bcbf2eb7963ef0ac3da519107aba151f77f
DIFF: https://github.com/llvm/llvm-project/commit/b3c72bcbf2eb7963ef0ac3da519107aba151f77f.diff

LOG: [Flang][OpenMP] Issue error if reduction clause has proc-pointer (#88999)

OpenMP 5.2: Section 5.5.5: A procedure pointer must not appear in a
reduction clause.

Fixes #87915

Added: 
    flang/test/Semantics/OpenMP/reduction12.f90

Modified: 
    flang/lib/Semantics/check-omp-structure.cpp

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index bafa242a79302a..56653aa74f0cc5 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 00000000000000..f896ca4aa60b67
--- /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