[flang][OpenMP] Implement CheckReductionObjects for all reduction c… (#118689)

…lauses

Currently we only do semantic checks for REDUCTION. There are two other
clauses, IN_REDUCTION, and TASK_REDUCTION which will also need those
checks. Implement a function that checks the common list-item
requirements for all those clauses.

Author: kparzysz

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

@@ -146,13 +146,14 @@ class OmpStructureChecker
   bool CheckAllowedClause(llvmOmpClause clause);
   bool IsVariableListItem(const Symbol &sym);
   bool IsExtendedListItem(const Symbol &sym);
+  bool IsCommonBlock(const Symbol &sym);
   std::optional<bool> IsContiguous(const parser::OmpObject &object);
   void CheckMultipleOccurrence(semantics::UnorderedSymbolSet &listVars,
       const std::list<parser::Name> &nameList, const parser::CharBlock &item,
       const std::string &clauseName);
   void CheckMultListItems();
-  void CheckStructureElement(const parser::OmpObjectList &ompObjectList,
-      const llvm::omp::Clause clause);
+  void CheckStructureComponent(
+      const parser::OmpObjectList &objects, llvm::omp::Clause clauseId);
   bool HasInvalidWorksharingNesting(
       const parser::CharBlock &, const OmpDirectiveSet &);
   bool IsCloselyNestedRegion(const OmpDirectiveSet &set);
@@ -171,6 +172,9 @@ class OmpStructureChecker
       typename IterTy = decltype(std::declval<RangeTy>().begin())>
   std::optional<IterTy> FindDuplicate(RangeTy &&);
 
+  const Symbol *GetObjectSymbol(const parser::OmpObject &object);
+  std::optional<parser::CharBlock> GetObjectSource(
+      const parser::OmpObject &object);
   void CheckDependList(const parser::DataRef &);
   void CheckDependArraySection(
       const common::Indirection<parser::ArrayElement> &, const parser::Name &);
@@ -182,8 +186,8 @@ class OmpStructureChecker
       const parser::OmpObjectList &objList);
   void CheckSymbolNames(
       const parser::CharBlock &source, const parser::OmpObjectList &objList);
-  void CheckIntentInPointer(
-      const parser::OmpObjectList &, const llvm::omp::Clause);
+  void CheckIntentInPointer(SymbolSourceMap &, const llvm::omp::Clause);
+  void CheckProcedurePointer(SymbolSourceMap &, const llvm::omp::Clause);
   void GetSymbolsInObjectList(const parser::OmpObjectList &, SymbolSourceMap &);
   void CheckDefinableObjects(SymbolSourceMap &, const llvm::omp::Clause);
   void CheckCopyingPolymorphicAllocatable(
@@ -220,6 +224,8 @@ class OmpStructureChecker
   void CheckCancellationNest(
       const parser::CharBlock &source, const parser::OmpCancelType::Type &type);
   std::int64_t GetOrdCollapseLevel(const parser::OpenMPLoopConstruct &x);
+  void CheckReductionObjects(
+      const parser::OmpObjectList &objects, llvm::omp::Clause clauseId);
   bool CheckReductionOperators(const parser::OmpClause::Reduction &);
   bool CheckIntrinsicOperator(
       const parser::DefinedOperator::IntrinsicOperator &);
@@ -232,8 +238,6 @@ class OmpStructureChecker
   void ChecksOnOrderedAsStandalone();
   void CheckOrderedDependClause(std::optional<std::int64_t> orderedValue);
   void CheckReductionArraySection(const parser::OmpObjectList &ompObjectList);
-  void CheckIntentInPointerAndDefinable(
-      const parser::OmpObjectList &, const llvm::omp::Clause);
   void CheckArraySection(const parser::ArrayElement &arrayElement,
       const parser::Name &name, const llvm::omp::Clause clause);
   void CheckSharedBindingInOuterContext(

flang/lib/Semantics/check-omp-structure.h

@@ -2,7 +2,7 @@
 
 subroutine f00(x)
   integer :: x(10)
-!ERROR: Reference to x must be a contiguous object
+!ERROR: Reference to 'x' must be a contiguous object
   !$omp target update from(x(1:10:2))
 end
 

flang/test/Semantics/OpenMP/from-clause-v45.f90

@@ -14,8 +14,7 @@ program omp_Reduction
   end do
   !$omp end parallel do
 
-  !ERROR: Variable 'c' on the REDUCTION clause is not definable
-  !BECAUSE: 'c' is not a variable
+  !ERROR: Common block names are not allowed in REDUCTION clause
   !$omp parallel do reduction(*:/c/)
   do i = 1, 10
     l = k + 1

flang/test/Semantics/OpenMP/reduction04.f90

@@ -8,21 +8,21 @@ program omp_reduction
   integer :: k = 10
   integer :: a(10), b(10,10,10)
 
-  !ERROR: A list item that appears in a REDUCTION clause should have a contiguous storage array section.
+  !ERROR: Reference to 'a' must be a contiguous object
   !$omp parallel do reduction(+:a(1:10:3))
   do i = 1, 10
     k = k + 1
   end do
   !$omp end parallel do
 
-  !ERROR: A list item that appears in a REDUCTION clause should have a contiguous storage array section.
+  !ERROR: Reference to 'b' must be a contiguous object
   !$omp parallel do reduction(+:b(1:10:3,1:8:1,1:5:1))
   do i = 1, 10
     k = k + 1
   end do
   !$omp end parallel do
 
-  !ERROR: A list item that appears in a REDUCTION clause should have a contiguous storage array section.
+  !ERROR: Reference to 'b' must be a contiguous object
   !$omp parallel do reduction(+:b(1:10:1,1:8:2,1:5:1))
   do i = 1, 10
     k = k + 1

flang/test/Semantics/OpenMP/reduction06.f90

@@ -6,7 +6,7 @@
   procedure(foo), pointer :: ptr
   integer :: i
   ptr => foo
-!ERROR: A procedure pointer 'ptr' must not appear in a REDUCTION clause.
+!ERROR: Procedure pointer 'ptr' may not appear in a REDUCTION clause
 !$omp do reduction (+ : ptr)
   do i = 1, 10
   end do

flang/test/Semantics/OpenMP/reduction12.f90

@@ -0,0 +1,32 @@
+!RUN: %python %S/../test_errors.py %s %flang_fc1 -fopenmp -fopenmp-version=50
+
+!Ref: [5.0:297:28-29]
+! If a list item is an array section or an array element, its base expression
+! must be a base language identifier.
+
+module m
+  type t
+    integer :: a(10)
+  end type
+
+contains
+
+  subroutine f00
+    type(t) :: x
+  !ERROR: The base expression of an array element or section in REDUCTION clause must be an identifier
+  !$omp do reduction (+ : x%a(2))
+    do i = 1, 10
+    end do
+  !$omp end do
+  end subroutine
+
+  subroutine f01
+    type(t) :: x
+  !ERROR: The base expression of an array element or section in REDUCTION clause must be an identifier
+  !$omp do reduction (+ : x%a(1:10))
+    do i = 1, 10
+    end do
+  !$omp end do
+  end subroutine
+end
+

flang/test/Semantics/OpenMP/reduction15.f90

@@ -0,0 +1,14 @@
+!RUN: %python %S/../test_errors.py %s %flang_fc1 -fopenmp -fopenmp-version=50
+
+!Ref: [5.0:298:19]
+! A type parameter inquiry cannot appear in a reduction clause.
+
+subroutine f00
+  integer :: x
+!ERROR: Type parameter inquiry is not permitted in REDUCTION clause
+!$omp do reduction (+ : x%kind)
+  do i = 1, 10
+  end do
+!$omp end do
+end subroutine
+

flang/test/Semantics/OpenMP/reduction16.f90

@@ -2,7 +2,7 @@
 
 subroutine f00(x)
   integer :: x(10)
-!ERROR: Reference to x must be a contiguous object
+!ERROR: Reference to 'x' must be a contiguous object
   !$omp target update to(x(1:10:2))
 end
 

flang/test/Semantics/OpenMP/to-clause-v45.f90

@@ -15,7 +15,7 @@ subroutine omp_target_data
    type(my_type) :: my_var
    a = 1
 
-   !ERROR: A variable that is part of another variable (structure element) cannot appear on the TARGET DATA USE_DEVICE_ADDR clause
+   !ERROR: A variable that is part of another variable cannot appear on the USE_DEVICE_ADDR clause
    !$omp target data map(tofrom: a) use_device_addr(my_var%my_b)
       my_var%my_b = a
    !$omp end target data

flang/test/Semantics/OpenMP/use_device_addr1.f90

@@ -20,7 +20,7 @@ subroutine omp_target_data
    type(my_type) :: my_var
    a = 1
 
-   !ERROR: A variable that is part of another variable (structure element) cannot appear on the TARGET DATA USE_DEVICE_PTR clause
+   !ERROR: A variable that is part of another variable cannot appear on the USE_DEVICE_PTR clause
    !$omp target data map(tofrom: a, arrayB) use_device_ptr(my_var%my_cptr)
       allocate(arrayB)
       call c_f_pointer(my_var%my_cptr, arrayB)