[Flang][OpenMP 4.5] Add semantic check for OpenMP Do Loop Constructs for single directive

[yhegde]

Summary

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

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

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

[clementval]

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

140

Maybe add a blank line here to keep with the style of this file?

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

96

Doesn't really check smth but set a state in the context. Should it be renamed ?

106

Remove blank line.

155

dirContext_ act as a stack so do you really intent to go from the bottom of the stack to the top? If so no problem. Just asking.

521

Extra blank line.

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

211

Remove blank line. Style is not really consistent across file but let's try to keep with the same style in a single file.

[yhegde]

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

96

Ok . I can change it to SetLoopInfo .

155

Yes. Check on nesting is called only if Do directive present in that stack.

[yhegde]

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

211

That blank line is left to separate the functions specific to a patch just like a blank line is left before CheckDependList.

[yhegde]

This patch is updated with corrections to positive test cases and indentations.

[kiranchandramohan]

Why are you changing the tests while removing XFAIL? eg. omp-do05.f90 was supposed to check chunk_size.

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

519

We capture data-sharing attributes in resolve-directives right? Why is this function better here compared to resolve-directives?

[kiranchandramohan]

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

155

Should this call to HasInvalidWorksharingNesting be similar to the one in OpenMPLoopDirective and happen before pushing the context and not iterate over the entire stack of contexts?

[yhegde]

In D93205#2466522, @kiranchandramohan wrote:

Why are you changing the tests while removing XFAIL? eg. omp-do05.f90 was supposed to check chunk_size.

The chunk_size is checked and committed. (https://reviews.llvm.org/D89546) . We found this as a duplicate test case committed earlier by us with XFAIL so thought of re using it. Same with omp-do01.f90 also . Collapse and Ordered with loop levels is already checked and committed. (https://reviews.llvm.org/D89860) Hence we thought of reusing it.

[yhegde]

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

155

In OpenMPLoopDirective OMPD_Do context is pushed after calling HasInvalidWorksharingNesting. So I could not do this check in a similar way.

[kiranchandramohan]

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

155

Is there any issue with pushing the context after calling HasInvalidWorksharingNesting here also?

[yhegde]

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

155

I suppose you mean pushing OMPD_Do context after calling HasInvalidWorksharingNesting ? . If so , then it is not required to push that context later. Control reaches OpenMPLoopDirective first and then OMPD_single.

[yhegde]

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

519

Do you mean CheckMultipleAppearances in resolve-directives? I think It works for same or different clauses containing same symbols when they are in the same directive context. or I may be missing something.

[yhegde]

Rebased with some code changes.

[yhegde]

Rebased again.

[kiranchandramohan]

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

155

I was asking whether it is OK to implement it the following way so that we don't have to use FindInEnclosingDirContext function?

  if (beginDir.v == llvm::omp::Directive::OMPD_single) {
    HasInvalidWorksharingNesting(...);
  }

  PushContextAndClauseSets(beginDir.source, beginDir.v);

  switch (beginDir.v) {
  case llvm::omp::OMPD_parallel:
    CheckNoBranching(block, llvm::omp::OMPD_parallel, beginDir.source);
    break;
  default:
    break;
  }
}

526

Does the context have the current directive? If so can we get the loopIV through the directive and avoid the need to store the loopIV field?

[yhegde]

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

155

FindEnclosingDirContext function can check any restrictive directives for "single" , like "critical" or "task" - if in case it is required to check . Otherwise I can call

if (beginDir.v == llvm::omp::Directive::OMPD_single) {

  HasInvalidWorksharingNesting(HasInvalidWorksharingNesting(
        beginDir.source, {llvm::omp::Directive::OMPD_do}););
}

before pushing the PushContextAndClauseSets(beginDir.source, beginDir.v) and get the expected error.

526

I suppose I require OpenMPLoopConstruct and DoConstruct to get loopIndex. dirContext_ gives directivesource and llvm::omp::Directive , directiveEnum.

[kiranchandramohan]

Looks mostly OK. Just one issue (FindEnclosingDirContext) to take a decision.

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

155

If you want to check for restrictions besides OMPD_do, then you can add them to the set like the following isn't it?

if (beginDir.v == llvm::omp::Directive::OMPD_single) {
  HasInvalidWorksharingNesting(
       beginDir.source{llvm::omp::Directive::OMPD_do,
                                   llvm::omp::Directive::OMPD_critical,
                                   llvm::omp::Directive::OMPD_task});
}

Anyway the FindEnclosingDirContext is probably not needed for this patch. If we need it later then we can introduce it there. If you agree please remove FindEnclosingDirContext.

[yhegde]

Addressed the review comments.

[yhegde]

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

155

ok. Then I suppose 'single' binds to immediate outer directive context irrespective of that context. I have moved code before pushing the context. Thanks for the review comments.

[kiranchandramohan]

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

155

Can you point me to this restriction for single in the standard?

[yhegde]

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

155

I was under an impression that FindInEnclosingDircontext check is required in one such following case:

program omp_do

integer a(10),b(10),c(10)

!$omp parallel sections
!$omp section
!$omp critical
!$omp do

do i=1,10

!$omp parallel

a(i) = b(i) + c(i)

!$omp single

j = j + 1

!$omp end single
!$omp end parallel
end do
!$omp end critical
!$omp end parallel sections

But may be it is enough to check immediate outer dir context. So I have updated the diff with suggested changes.

[kiranchandramohan]

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

155

To confirm whether it is a closely nested (construct/region) check or a general nested check, I would like to see which specific restriction you are implementing here from the standard. I could not find the single restriction in the worksharing loop section (2.7.1). Did I miss?

However, I see the following in Section 2.17
• A worksharing region may not be closely nested inside a worksharing, explicit task, taskloop, critical, ordered, atomic, or master region

Please clarify which specific restriction you are implementing here.

[yhegde]

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

155

The case related to 'single' - (omp-do05.f90) is listed under 2.7.1 with restriction description "All loops associated with the loop construct must be perfectly nested; that is, there must be no intervening code nor any OpenMP directive between any two loops.".

The spec https://www.openmp.org/wp-content/uploads/openmp-examples-4.5.0.pdf , page 277 , gives a similar example calling it as "non-conforming example because the loop and single regions are closely nested.

gfortran throws an error - "work-sharing region may not be closely nested inside of work-sharing, ‘critical’, ‘ordered’, ‘master’, explicit ‘task’ or ‘taskloop’ region" - for these cases.

[kiranchandramohan]

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

155

I believe the 2.7.1 restriction "All loops associated with the loop construct must be perfectly nested" refers to cases where there are more than one loop associated with the "omp do", for e.g. when there is a collapse clause.

The example you refer to in page 277 (openmp examples) is under the "restrictions on nesting of regions" section.

And the gfortran error is similar to the nesting restrictions in Section 2.17 (openmp 4.5 standard). So I believe what you are implementing here is a case of the following restriction with the first worksharing region being "single" and the second being "worksharing loop (do)".

A worksharing region may not be closely nested inside a worksharing, explicit task, taskloop, critical, ordered, atomic, or master region

The standard defines closely nested region as follows in Page 6.

A region nested inside another region with no parallel region nested between them.

So the following example from page 277 you mention should result in an error.

SUBROUTINE PROG(N)
  INTEGER N
  INTEGER I
  !$OMP PARALLEL DEFAULT(SHARED)
  !$OMP DO
  DO I = 1, N
    !$OMP SINGLE ! incorrect nesting of regions
    CALL WORK(I, 1)
    !$OMP END SINGLE
  END DO
  !$OMP END DO
  !$OMP END PARALLEL
END SUBROUTINE PROG

But the following modified version with parallel inserted before single should not result in an error.

SUBROUTINE PROG(N)
  INTEGER N
  INTEGER I
  !$OMP PARALLEL DEFAULT(SHARED)
  !$OMP DO
  DO I = 1, N
    !$OMP PARALLEL
    !$OMP SINGLE ! correct nesting of regions
    CALL WORK(I, 1)
    !$OMP END SINGLE
    !$OMP END PARALLEL
  END DO
  !$OMP END DO
  !$OMP END PARALLEL
END SUBROUTINE PROG

Ideally this could have been implemented as a separate patch for nesting of regions checks. But I do not mind if you continue here.

[yhegde]

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

155

Thank you @kiranchandramohan . Shall I update the patch with these two test cases. ?

[kiranchandramohan]

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

155

Yes, please add these two tests and also add a TODO in the source code saying that this check will need to be extended or generalised while implementing nesting of regions checks.

Also. update the table entry in nesting of regions for "A worksharing region may not be closely nested inside a worksharing, explicit task, taskloop, critical, ordered, atomic, or master region." from implemented to partially implemented.

[yhegde]

Updated the patch with few more test cases.

[yhegde]

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

155

ok.

[yhegde]

Rebased with the latest changes.

[kiranchandramohan]

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

526

Is loopIV cleared somewhere? I believe stale values can cause this check to incorrectly fire.

[yhegde]

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

526

ok. Resetting the loopIV in the ResetPartialContext function.

[yhegde]

Addressed the review comments related to loopIV.

[kiranchandramohan]

LGTM. Thanks for the patience.

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

struct DirectiveContext {
     common::EnumSet<C, ClauseEnumSize> allowedClauses{};
     common::EnumSet<C, ClauseEnumSize> allowedOnceClauses{};
     common::EnumSet<C, ClauseEnumSize> allowedExclusiveClauses{};
     common::EnumSet<C, ClauseEnumSize> requiredClauses{};
 
     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());
     return dirContext_.back();
   }
 
   void SetContextClause(const PC &clause) {
     GetContext().clauseSource = clause.source;

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

: public DirectiveStructureChecker<llvm::omp::Directive, llvm::omp::Clause,
           parser::OmpClause, llvm::omp::Clause_enumSize> {
 public:
   OmpStructureChecker(SemanticsContext &context)
       : DirectiveStructureChecker(context,
 #define GEN_FLANG_DIRECTIVE_CLAUSE_MAP
 #include "llvm/Frontend/OpenMP/OMP.inc"
         ) {
   }
+  using llvmOmpClause = const llvm::omp::Clause;
 
   void Enter(const parser::OpenMPConstruct &);
   void Enter(const parser::OpenMPLoopConstruct &);
   void Leave(const parser::OpenMPLoopConstruct &);
   void Enter(const parser::OmpEndLoopDirective &);
 
   void Enter(const parser::OpenMPBlockConstruct &);
   void Leave(const parser::OpenMPBlockConstruct &);
private:
   void CheckDependList(const parser::DataRef &);
   void CheckDependArraySection(
       const common::Indirection<parser::ArrayElement> &, const parser::Name &);
   void CheckIsVarPartOfAnotherVar(const parser::OmpObjectList &objList);
   void CheckIntentInPointer(
       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/lib/Semantics/check-omp-structure.cpp

HasInvalidWorksharingNesting(beginDir.source,
             llvm::omp::Directive::OMPD_task,
             llvm::omp::Directive::OMPD_taskloop,
             llvm::omp::Directive::OMPD_critical,
             llvm::omp::Directive::OMPD_ordered,
             llvm::omp::Directive::OMPD_atomic,
             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 &) {
   dirContext_.pop_back();
 }
 
 void OmpStructureChecker::Enter(const parser::OmpEndLoopDirective &x) {
   const auto &dir{std::get<parser::OmpLoopDirective>(x.t)};
void OmpStructureChecker::Enter(const parser::OpenMPBlockConstruct &x) {
   const auto &beginBlockDir{std::get<parser::OmpBeginBlockDirective>(x.t)};
   const auto &endBlockDir{std::get<parser::OmpEndBlockDirective>(x.t)};
   const auto &beginDir{std::get<parser::OmpBlockDirective>(beginBlockDir.t)};
   const auto &endDir{std::get<parser::OmpBlockDirective>(endBlockDir.t)};
   const parser::Block &block{std::get<parser::Block>(x.t)};
 
   CheckMatching<parser::OmpBlockDirective>(beginDir, endDir);
 
+  if (beginDir.v == llvm::omp::Directive::OMPD_single) {
+    HasInvalidWorksharingNesting(
+        beginDir.source, {llvm::omp::Directive::OMPD_do});
+  }
+
   PushContextAndClauseSets(beginDir.source, beginDir.v);
 
   switch (beginDir.v) {
   case llvm::omp::OMPD_parallel:
     CheckNoBranching(block, llvm::omp::OMPD_parallel, beginDir.source);
     break;
   default:
     break;
   }
 }
 
 void OmpStructureChecker::Leave(const parser::OpenMPBlockConstruct &) {
   dirContext_.pop_back();
 }
 
 void OmpStructureChecker::Enter(const parser::OpenMPSectionsConstruct &x) {

 // Following clauses do not have a seperate node in parse-tree.h.
 // They fall under 'struct OmpClause' in parse-tree.h.
 CHECK_SIMPLE_CLAUSE(Allocate, OMPC_allocate)
 CHECK_SIMPLE_CLAUSE(Copyin, OMPC_copyin)
 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)
 CHECK_SIMPLE_CLAUSE(Lastprivate, OMPC_lastprivate)
 CHECK_SIMPLE_CLAUSE(Link, OMPC_link)
 CHECK_SIMPLE_CLAUSE(Mergeable, OMPC_mergeable)
 CHECK_SIMPLE_CLAUSE(Nogroup, OMPC_nogroup)
 CHECK_SIMPLE_CLAUSE(Notinbranch, OMPC_notinbranch)
std::visit(
                 }
               }
             },
             [&](const parser::Name &name) {},
         },
         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)
 CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicWrite, OMPC_write)
 CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicUpdate, OMPC_update)
 CHECK_SIMPLE_PARSER_CLAUSE(OmpAtomicCapture, OMPC_capture)
 
 void OmpStructureChecker::Leave(const parser::OmpAtomicRead &) {

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

+! 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

 ! 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
 
 end program omp_do

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

+! 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

 ! 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