[Flang][openmp]Fix crash in OpenMP semantic check( bug 48308)

Fixes the bug reported in https://bugs.llvm.org/show_bug.cgi?id=48308

Reviewed By: kiranchandramohan, clementval

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

diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp
index 56f8f8fae9551bc39645886bc44c791e7a79bb5b..16fdb09a5dbc704f12064eadebc531ab135dce59 100644 (file)
--- a/flang/lib/Semantics/resolve-directives.cpp
+++ b/flang/lib/Semantics/resolve-directives.cpp
@@ -875,17 +875,24 @@ void OmpAttributeVisitor::ResolveSeqLoopIndexInParallelOrTaskConstruct(
   }
 }
 
-// 2.15.1.1 Data-sharing Attribute Rules - Predetermined
+// [OMP-4.5]2.15.1.1 Data-sharing Attribute Rules - Predetermined
 //   - A loop iteration variable for a sequential loop in a parallel
 //     or task generating construct is private in the innermost such
 //     construct that encloses the loop
+// Loop iteration variables are not well defined for DO WHILE loop.
+// Use of DO CONCURRENT inside OpenMP construct is unspecified behavior
+// till OpenMP-5.0 standard.
+// In above both cases we skip the privatization of iteration variables.
 bool OmpAttributeVisitor::Pre(const parser::DoConstruct &x) {
-  if (!dirContext_.empty() && GetContext().withinConstruct) {
-    if (const auto &iv{GetLoopIndex(x)}; iv.symbol) {
-      if (!iv.symbol->test(Symbol::Flag::OmpPreDetermined)) {
-        ResolveSeqLoopIndexInParallelOrTaskConstruct(iv);
-      } else {
-        // TODO: conflict checks with explicitly determined DSA
+  // TODO:[OpenMP 5.1] DO CONCURRENT indices are private
+  if (x.IsDoNormal()) {
+    if (!dirContext_.empty() && GetContext().withinConstruct) {
+      if (const auto &iv{GetLoopIndex(x)}; iv.symbol) {
+        if (!iv.symbol->test(Symbol::Flag::OmpPreDetermined)) {
+          ResolveSeqLoopIndexInParallelOrTaskConstruct(iv);
+        } else {
+          // TODO: conflict checks with explicitly determined DSA
+        }
       }
     }
   }

diff --git a/flang/test/Semantics/omp-no-dowhile-in-parallel.f90 b/flang/test/Semantics/omp-no-dowhile-in-parallel.f90
new file mode 100644 (file)
index 0000000..f49d29c
--- /dev/null
+++ b/flang/test/Semantics/omp-no-dowhile-in-parallel.f90
@@ -0,0 +1,28 @@
+! RUN: %S/test_errors.sh %s %t %f18 -fopenmp
+
+subroutine bug48308(x,i)
+  real :: x(:)
+  integer :: i
+  !$omp parallel firstprivate(i)
+    do while (i>0)
+      x(i) = i
+      i = i - 1
+    end do
+  !$omp end parallel
+end subroutine
+
+subroutine s1(x,i)
+  real :: x(:)
+  integer :: i
+  !$omp parallel firstprivate(i)
+    do i = 10, 1, -1
+      x(i) = i
+    end do
+  !$omp end parallel
+
+  !$omp parallel firstprivate(i)
+    do concurrent (i = 1:10:1)
+      x(i) = i
+    end do
+  !$omp end parallel
+end subroutine