diff --git a/flang/lib/Semantics/check-omp-structure.h b/flang/lib/Semantics/check-omp-structure.h --- a/flang/lib/Semantics/check-omp-structure.h +++ b/flang/lib/Semantics/check-omp-structure.h @@ -166,7 +166,7 @@ private: bool HasInvalidWorksharingNesting( const parser::CharBlock &, const OmpDirectiveSet &); - + bool IsCloselyNestedRegion(const OmpDirectiveSet &set); // specific clause related bool ScheduleModifierHasType(const parser::OmpScheduleClause &, const parser::OmpScheduleModifierType::ModType &); diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp --- a/flang/lib/Semantics/check-omp-structure.cpp +++ b/flang/lib/Semantics/check-omp-structure.cpp @@ -127,11 +127,52 @@ std::map labelNamesandLevels_; }; +bool OmpStructureChecker::IsCloselyNestedRegion(const OmpDirectiveSet &set) { + // Definition of close nesting: + // + // `A region nested inside another region with no parallel region nested + // between them` + // + // Examples: + // non-parallel construct 1 + // non-parallel construct 2 + // parallel construct + // construct 3 + // In the above example, construct 3 is NOT closely nested inside construct 1 + // or 2 + // + // non-parallel construct 1 + // non-parallel construct 2 + // construct 3 + // In the above example, construct 3 is closely nested inside BOTH construct 1 + // and 2 + // + // Algorithm: + // Starting from the parent context, Check in a bottom-up fashion, each level + // of the context stack. If we have a match for one of the (supplied) + // violating directives, `close nesting` is satisfied. If no match is there in + // the entire stack, `close nesting` is not satisfied. If at any level, a + // `parallel` region is found, `close nesting` is not satisfied. + + if (CurrentDirectiveIsNested()) { + int index = dirContext_.size() - 2; + while (index != -1) { + if (set.test(dirContext_[index].directive)) { + return true; + } else if (llvm::omp::parallelSet.test(dirContext_[index].directive)) { + return false; + } + index--; + } + } + return false; +} + bool OmpStructureChecker::HasInvalidWorksharingNesting( const parser::CharBlock &source, const OmpDirectiveSet &set) { // set contains all the invalid closely nested directives // for the given directive (`source` here) - if (CurrentDirectiveIsNested() && set.test(GetContextParent().directive)) { + if (IsCloselyNestedRegion(set)) { context_.Say(source, "A worksharing region may not be closely nested inside a " "worksharing, explicit task, taskloop, critical, ordered, atomic, or " diff --git a/flang/test/Semantics/omp-do05.f90 b/flang/test/Semantics/omp-do05.f90 --- a/flang/test/Semantics/omp-do05.f90 +++ b/flang/test/Semantics/omp-do05.f90 @@ -6,7 +6,7 @@ program omp_do integer n - integer i,j + integer i,j,k !$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 @@ -18,6 +18,65 @@ end do !$omp end do + !$omp do + do i=1,10 + !$omp task + do j=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 k=1,10 + print *,"hello" + end do + !$omp end single + end do + !$omp end task + end do + !$omp end do + + !$omp do + do i=1,10 + !$omp parallel + do j=1,10 + !$omp single + do k=1,10 + print *,"hello" + end do + !$omp end single + end do + !$omp end parallel + end do + !$omp end do + +!$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 + !ERROR: A worksharing region may not be closely nested inside a worksharing, explicit task, taskloop, critical, ordered, atomic, or master region + !$omp single + do k=1,10 + print *,"hello" + end do + !$omp end single + end do + !$omp end single + + !ERROR: A worksharing region may not be closely nested inside a worksharing, explicit task, taskloop, critical, ordered, atomic, or master region + !$omp single + do k=1,10 + print *,"hello" + end do + !$omp end single + + !ERROR: A worksharing region may not be closely nested inside a worksharing, explicit task, taskloop, critical, ordered, atomic, or master region + !$omp do + do k=1,10 + print *,"hello" + end do + !$omp end do +end do +!$omp end do + !$omp parallel default(shared) !$omp do do i = 1, n @@ -29,4 +88,19 @@ !$omp end do !$omp end parallel + !$omp parallel default(shared) + !$omp do + do i = 1, n + !$omp task + do j=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 + call work(i, 1) + !$omp end single + end do + !$omp end task + end do + !$omp end do + !$omp end parallel + end program omp_do diff --git a/flang/test/Semantics/omp-nested01.f90 b/flang/test/Semantics/omp-nested01.f90 --- a/flang/test/Semantics/omp-nested01.f90 +++ b/flang/test/Semantics/omp-nested01.f90 @@ -11,4 +11,30 @@ a = 3.14 enddo enddo + + !$omp do + do i = 1, N + !$omp target + do k = 1,N + !ERROR: A worksharing region may not be closely nested inside a worksharing, explicit task, taskloop, critical, ordered, atomic, or master region + !$omp do + do j = 1, N + a = 3.14 + enddo + enddo + !$omp end target + enddo + + + !$omp do + do i = 1, N + !$omp parallel + do k = 1,N + !$omp do + do j = 1, N + a = 3.14 + enddo + enddo + !$omp end parallel + enddo end diff --git a/flang/test/Semantics/omp-reduction07.f90 b/flang/test/Semantics/omp-reduction07.f90 --- a/flang/test/Semantics/omp-reduction07.f90 +++ b/flang/test/Semantics/omp-reduction07.f90 @@ -54,6 +54,19 @@ !$omp end do !$omp end sections +!$omp sections private(k) + !$omp target + do j = 1,10 + !ERROR: A worksharing region may not be closely nested inside a worksharing, explicit task, taskloop, critical, ordered, atomic, or master region + !$omp do reduction(+:k) reduction(max:j) + do i = 1, 10 + k = k + 1 + end do + !$omp end do + end do + !$omp end target +!$omp end sections + !$omp parallel reduction(+:a) !ERROR: REDUCTION variable 'a' is REDUCTION in outer context must be shared in the parallel regions to which any of the worksharing regions arising from the worksharing construct bind. !$omp sections reduction(-:a)