From a89a3c2c7d55e672f5154408396975587f9de28c Mon Sep 17 00:00:00 2001
From: Yashaswini <yhegde@gmail.com>
Date: Mon, 8 Mar 2021 20:11:17 +0530
Subject: [PATCH] Add Semantic check for Flang OpenMP 4.5 - 2.7.1 Do Loop
 restrictions for Threadprivate. Implementation of Do loop threadprivate
 check.

Files:

resolve-directives.cpp

Testcases:

omp-do04-positivecase.f90
omp-do04.f90

Reviewed by: Kiran Chandramohan @kiranchandramohan

Differential Revision: https://reviews.llvm.org/D96686
---
 flang/lib/Semantics/resolve-directives.cpp    | 14 +++
 .../test/Semantics/omp-do04-positivecase.f90  | 22 +++++
 flang/test/Semantics/omp-do04.f90             | 97 +++++++++++++++++--
 3 files changed, 125 insertions(+), 8 deletions(-)
 create mode 100644 flang/test/Semantics/omp-do04-positivecase.f90

diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp
index 726ffb1975d7..27311db28cc5 100644
--- a/flang/lib/Semantics/resolve-directives.cpp
+++ b/flang/lib/Semantics/resolve-directives.cpp
@@ -478,7 +478,9 @@ private:
     sourceLabels_.clear();
     targetLabels_.clear();
   };
+
   bool HasSymbolInEnclosingScope(const Symbol &, Scope &);
+  std::int64_t ordCollapseLevel{0};
 };
 
 template <typename T>
@@ -1084,6 +1086,7 @@ bool OmpAttributeVisitor::Pre(const parser::OpenMPLoopConstruct &x) {
     }
   }
   PrivatizeAssociatedLoopIndexAndCheckLoopLevel(x);
+  ordCollapseLevel = GetAssociatedLoopLevelFromClauses(clauseList) + 1;
   return true;
 }
 
@@ -1127,6 +1130,17 @@ bool OmpAttributeVisitor::Pre(const parser::DoConstruct &x) {
         } else {
           // TODO: conflict checks with explicitly determined DSA
         }
+        ordCollapseLevel--;
+        if (ordCollapseLevel) {
+          if (const auto *details{iv.symbol->detailsIf<HostAssocDetails>()}) {
+            const Symbol *tpSymbol = &details->symbol();
+            if (tpSymbol->test(Symbol::Flag::OmpThreadprivate)) {
+              context_.Say(iv.source,
+                  "Loop iteration variable %s is not allowed in THREADPRIVATE."_err_en_US,
+                  iv.ToString());
+            }
+          }
+        }
       }
     }
   }
diff --git a/flang/test/Semantics/omp-do04-positivecase.f90 b/flang/test/Semantics/omp-do04-positivecase.f90
new file mode 100644
index 000000000000..852aaf135b67
--- /dev/null
+++ b/flang/test/Semantics/omp-do04-positivecase.f90
@@ -0,0 +1,22 @@
+! RUN: %S/test_symbols.sh %s %t %f18 -fopenmp
+! OpenMP Version 4.5
+! 2.7.1 Do Loop Constructs
+
+!DEF: /omp_do1 MainProgram
+program omp_do1
+  !DEF: /omp_do1/i ObjectEntity INTEGER(4)
+  !DEF: /omp_do1/j ObjectEntity INTEGER(4)
+  !DEF: /omp_do1/k (OmpThreadprivate) ObjectEntity INTEGER(4)
+  !DEF: /omp_do1/n (OmpThreadprivate) ObjectEntity INTEGER(4)
+  integer i, j, k, n
+  !$omp threadprivate (k,n)
+  !$omp do
+  !DEF: /omp_do1/Block1/i (OmpPrivate, OmpPreDetermined) HostAssoc INTEGER(4)
+  do i=1,10
+    !REF: /omp_do1/j
+    do j=1,10
+      print *, "Hello"
+    end do
+  end do
+  !$omp end do
+end program omp_do1
diff --git a/flang/test/Semantics/omp-do04.f90 b/flang/test/Semantics/omp-do04.f90
index 857df1cf2744..f52f5ef1b709 100644
--- a/flang/test/Semantics/omp-do04.f90
+++ b/flang/test/Semantics/omp-do04.f90
@@ -1,15 +1,27 @@
-! RUN: %S/test_errors.sh %s %t %flang -fopenmp
-! XFAIL: *
-
+! RUN: %S/test_errors.sh %s %t %f18 -fopenmp
 ! OpenMP Version 4.5
 ! 2.7.1 Loop Construct
 ! The loop iteration variable may not appear in a threadprivate directive.
 
-program omp_do
-  integer i, j, k
 
-  !$omp do firstprivate(i)
-  !ERROR: !$OMP DO iteration variable i is not allowed in threadprivate
+program omp_do
+  integer, save:: i, j, k,n
+  !$omp  threadprivate(k,j,i)
+  !$omp  do collapse(2)
+  !ERROR: Loop iteration variable i is not allowed in THREADPRIVATE.
+  do i = 1, 10
+    !ERROR: Loop iteration variable j is not allowed in THREADPRIVATE.
+    do j = 1, 10
+      print *, "Hello"
+    end do
+  end do
+  !$omp end do
+end program omp_do
+
+program omp_do1
+  !$omp  threadprivate(k,j,i)
+  !$omp  do
+  !ERROR: Loop iteration variable i is not allowed in THREADPRIVATE.
   do i = 1, 10
     do j = 1, 10
       print *, "Hello"
@@ -17,4 +29,73 @@ program omp_do
   end do
   !$omp end do
 
-end program omp_do
+end program omp_do1
+
+program omp_do2
+  !$omp threadprivate(k)
+  !$omp threadprivate(j)
+  call compute()
+  contains
+  subroutine compute()
+  !$omp  do ordered(1) collapse(1)
+  !ERROR: Loop iteration variable k is not allowed in THREADPRIVATE.
+  foo: do k = 1, 10
+    do i = 1, 10
+      print *, "Hello"
+    end do
+  end do foo
+  !$omp end do
+  end subroutine
+
+end program omp_do2
+
+program omp_do3
+  !$omp  threadprivate(i)
+  !$omp parallel
+  print *, "parallel"
+  !$omp end parallel
+  !$omp  do
+  !ERROR: Loop iteration variable i is not allowed in THREADPRIVATE.
+  do i = 1, 10
+    do j = 1, 10
+      print *, "Hello"
+    end do
+  end do
+  !$omp end do
+
+end program omp_do3
+
+module tp
+  !integer i,j
+  integer, save:: i, j, k,n
+  !$omp threadprivate(i)
+  !$omp threadprivate(j)
+end module tp
+
+module usetp
+  use tp
+end module usetp
+
+program main
+  use usetp
+  !$omp  do
+  !ERROR: Loop iteration variable i is not allowed in THREADPRIVATE.
+  do i = 1, 10
+    do j = 1, 10
+      print *, "Hello"
+    end do
+  end do
+  !$omp end do
+end program
+
+program main1
+  use tp
+  !$omp  do
+  !ERROR: Loop iteration variable j is not allowed in THREADPRIVATE.
+  do j = 1, 10
+    do i = 1, 10
+      print *, "Hello"
+    end do
+  end do
+  !$omp end do
+end program