Add Semantic check for Flang OpenMP 4.5 - 2.7.1 Do Loop restrictions on single directive and firstprivate clause.

Semantic checks added to check the worksharing 'single' region closely nested inside a worksharing 'do' region. And also to check whether the 'do' iteration variable is a variable in 'Firstprivate' clause.

Files:
check-directive-structure.h
check-omp-structure.h
check-omp-structure.cpp

Testcases:
omp-do01-positivecase.f90
omp-do01.f90
omp-do05-positivecase.f90
omp-do05.f90

Reviewed by: Kiran Chandramohan @kiranchandramohan , Valentin Clement @clementval

Differential Revision: https://reviews.llvm.org/D93205

Author: YashaswiniHegde

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

@@ -139,8 +139,11 @@ class DirectiveStructureChecker : public virtual BaseChecker {
     const PC *clause{nullptr};
     std::multimap<C, const PC *> clauseInfo;
     std::list<C> actualClauses;
+    Symbol *loopIV{nullptr};
   };
 
+  void SetLoopIv(Symbol *symbol) { GetContext().loopIV = symbol; }
+
   // back() is the top of the stack
   DirectiveContext &GetContext() {
     CHECK(!dirContext_.empty());
@@ -160,6 +163,7 @@ class DirectiveStructureChecker : public virtual BaseChecker {
     GetContext().allowedExclusiveClauses = {};
     GetContext().requiredClauses = {};
     GetContext().clauseInfo = {};
+    GetContext().loopIV = {nullptr};
   }
 
   void SetContextDirectiveSource(const parser::CharBlock &directive) {

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

@@ -93,6 +93,22 @@ void OmpStructureChecker::Enter(const parser::OpenMPLoopConstruct &x) {
             llvm::omp::Directive::OMPD_master});
     PushContextAndClauseSets(beginDir.source, llvm::omp::Directive::OMPD_do);
   }
+  SetLoopInfo(x);
+}
+const parser::Name OmpStructureChecker::GetLoopIndex(
+    const parser::DoConstruct *x) {
+  using Bounds = parser::LoopControl::Bounds;
+  return std::get<Bounds>(x->GetLoopControl()->u).name.thing;
+}
+void OmpStructureChecker::SetLoopInfo(const parser::OpenMPLoopConstruct &x) {
+  if (const auto &loopConstruct{
+          std::get<std::optional<parser::DoConstruct>>(x.t)}) {
+    const parser::DoConstruct *loop{&*loopConstruct};
+    if (loop && loop->IsDoNormal()) {
+      const parser::Name &itrVal{GetLoopIndex(loop)};
+      SetLoopIv(itrVal.symbol);
+    }
+  }
 }
 
 void OmpStructureChecker::Leave(const parser::OpenMPLoopConstruct &) {
@@ -124,6 +140,13 @@ void OmpStructureChecker::Enter(const parser::OpenMPBlockConstruct &x) {
 
   CheckMatching<parser::OmpBlockDirective>(beginDir, endDir);
 
+  // TODO: This check needs to be extended while implementing nesting of regions
+  // checks.
+  if (beginDir.v == llvm::omp::Directive::OMPD_single) {
+    HasInvalidWorksharingNesting(
+        beginDir.source, {llvm::omp::Directive::OMPD_do});
+  }
+
   PushContextAndClauseSets(beginDir.source, beginDir.v);
   CheckNoBranching(block, beginDir.v, beginDir.source);
 }
@@ -401,7 +424,6 @@ CHECK_SIMPLE_CLAUSE(Copyprivate, OMPC_copyprivate)
 CHECK_SIMPLE_CLAUSE(Default, OMPC_default)
 CHECK_SIMPLE_CLAUSE(Device, OMPC_device)
 CHECK_SIMPLE_CLAUSE(Final, OMPC_final)
-CHECK_SIMPLE_CLAUSE(Firstprivate, OMPC_firstprivate)
 CHECK_SIMPLE_CLAUSE(From, OMPC_from)
 CHECK_SIMPLE_CLAUSE(Inbranch, OMPC_inbranch)
 CHECK_SIMPLE_CLAUSE(IsDevicePtr, OMPC_is_device_ptr)
@@ -487,6 +509,23 @@ void OmpStructureChecker::CheckIsVarPartOfAnotherVar(
         ompObject.u);
   }
 }
+void OmpStructureChecker::Enter(const parser::OmpClause::Firstprivate &x) {
+  CheckAllowed(llvm::omp::Clause::OMPC_firstprivate);
+  CheckIsLoopIvPartOfClause(llvmOmpClause::OMPC_firstprivate, x.v);
+}
+void OmpStructureChecker::CheckIsLoopIvPartOfClause(
+    llvmOmpClause clause, const parser::OmpObjectList &ompObjectList) {
+  for (const auto &ompObject : ompObjectList.v) {
+    if (const parser::Name * name{parser::Unwrap<parser::Name>(ompObject)}) {
+      if (name->symbol == GetContext().loopIV) {
+        context_.Say(name->source,
+            "DO iteration variable %s is not allowed in %s clause."_err_en_US,
+            name->ToString(),
+            parser::ToUpperCaseLetters(getClauseName(clause).str()));
+      }
+    }
+  }
+}
 // Following clauses have a seperate node in parse-tree.h.
 // Atomic-clause
 CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicRead, OMPC_read)

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

@@ -88,6 +88,7 @@ class OmpStructureChecker
 #include "llvm/Frontend/OpenMP/OMP.inc"
         ) {
   }
+  using llvmOmpClause = const llvm::omp::Clause;
 
   void Enter(const parser::OpenMPConstruct &);
   void Enter(const parser::OpenMPLoopConstruct &);
@@ -207,6 +208,11 @@ class OmpStructureChecker
       const parser::OmpObjectList &, const llvm::omp::Clause);
   void GetSymbolsInObjectList(
       const parser::OmpObjectList &, std::vector<const Symbol *> &);
+
+  const parser::Name GetLoopIndex(const parser::DoConstruct *x);
+  void SetLoopInfo(const parser::OpenMPLoopConstruct &x);
+  void CheckIsLoopIvPartOfClause(
+      llvmOmpClause clause, const parser::OmpObjectList &ompObjectList);
 };
 } // namespace Fortran::semantics
 #endif // FORTRAN_SEMANTICS_CHECK_OMP_STRUCTURE_H_

flang/test/Semantics/omp-do01-positivecase.f90

@@ -0,0 +1,19 @@
+! RUN: %S/test_symbols.sh %s %t %f18 -fopenmp
+! OpenMP Version 4.5
+! 2.7.1 Loop Construct
+! The loop iteration variable may not appear in a firstprivate directive.
+! A positive case
+
+!DEF: /omp_do MainProgram
+program omp_do
+  !DEF: /omp_do/i ObjectEntity INTEGER(4)
+  integer i
+
+  !$omp do  firstprivate(k)
+  !DEF: /omp_do/Block1/i (OmpPrivate, OmpPreDetermined) HostAssoc INTEGER(4)
+  do i=1,10
+    print *, "Hello"
+  end do
+  !$omp end do
+
+end program omp_do

flang/test/Semantics/omp-do01.f90

@@ -1,17 +1,17 @@
 ! RUN: %S/test_errors.sh %s %t %f18 -fopenmp
-! XFAIL: *
-
 ! OpenMP Version 4.5
 ! 2.7.1 Loop Construct
-! collapse(n) where n > num of loops
+! The loop iteration variable may not appear in a firstprivate directive.
 
 program omp_do
   integer i, j, k
 
-  !ERROR: Not enough do loops for collapsed !$OMP DO
-  !$omp do collapse(2)
+  !ERROR: DO iteration variable i is not allowed in FIRSTPRIVATE clause.
+  !$omp do firstprivate(k,i)
   do i = 1, 10
-    print *, "hello"
+    do j = 1, 10
+      print *, "Hello"
+    end do
   end do
   !$omp end do
 

flang/test/Semantics/omp-do05-positivecase.f90

@@ -0,0 +1,36 @@
+! RUN: %S/test_symbols.sh %s %t %f18 -fopenmp
+! OpenMP Version 4.5
+! 2.7.1 Loop Construct restrictions on single directive.
+! A positive case
+
+!DEF: /omp_do MainProgram
+program omp_do
+  !DEF: /omp_do/i ObjectEntity INTEGER(4)
+  !DEF: /omp_do/n ObjectEntity INTEGER(4)
+  integer i,n
+  !$omp parallel
+  !DEF: /omp_do/Block1/i (OmpPrivate, OmpPreDetermined) HostAssoc INTEGER(4)
+  do i=1,10
+    !$omp single
+    print *, "hello"
+    !$omp end single
+  end do
+  !$omp end parallel
+
+  !$omp parallel  default(shared)
+  !$omp do
+  !DEF: /omp_do/Block2/Block1/i (OmpPrivate, OmpPreDetermined) HostAssoc INTEGER(4)
+  !REF: /omp_do/n
+  do i=1,n
+    !$omp parallel
+    !$omp single
+    !DEF: /work EXTERNAL (Subroutine) ProcEntity
+    !REF: /omp_do/Block2/Block1/i
+    call work(i, 1)
+    !$omp end single
+    !$omp end parallel
+  end do
+  !$omp end do
+  !$omp end parallel
+
+end program omp_do

flang/test/Semantics/omp-do05.f90

@@ -1,26 +1,32 @@
 ! RUN: %S/test_errors.sh %s %t %f18 -fopenmp
-! XFAIL: *
-
 ! OpenMP Version 4.5
-! 2.7.1 Loop Construct
-! chunk_size must be a loop invariant integer expression
-! with a positive value.
+! 2.7.1 Loop Construct restrictions on single directive.
+
 
 program omp_do
-  integer i, j, k
-  integer :: a(10), b(10)
-  a = 10
-  j = 0
 
-  !ERROR: INTEGER expression of SCHEDULE clause chunk_size must be positive
-  !$omp do schedule(static, -1)
-  do i = 1, 10
-    j = j + 1
-    b(i) = a(i) * 2.0
+  integer n
+  integer i,j
+  !$omp do
+  do i=1,10
+    !ERROR: A worksharing region may not be closely nested inside a worksharing, explicit task, taskloop, critical, ordered, atomic, or master region
+    !$omp single
+    do j=1,10
+      print *,"hello"
+    end do
+    !$omp end single
   end do
   !$omp end do
 
-  print *, j
-  print *, b
+  !$omp parallel default(shared)
+  !$omp do
+  do i = 1, n
+    !ERROR: A worksharing region may not be closely nested inside a worksharing, explicit task, taskloop, critical, ordered, atomic, or master region
+    !$omp single
+    call work(i, 1)
+    !$omp end single
+  end do
+  !$omp end do
+  !$omp end parallel
 
 end program omp_do