[flang] 2.7.1 DO: Checks about clause arguments that allow Int Expr (flang-compiler...

All the IntExpr argument checks are done through evaluating the result of GetIntValue. If the argument is non-constant integer expr, Expression Analysis will be the gatekeeper.

Original-commit: flang-compiler/f18@d8c4804828c1f9f68088940a50c1380a18a72987
Reviewed-on: https://github.com/flang-compiler/f18/pull/540

diff --git a/flang/lib/semantics/check-omp-structure.cc b/flang/lib/semantics/check-omp-structure.cc
index ce7dc69..5591c0e 100644 (file)
--- a/flang/lib/semantics/check-omp-structure.cc
+++ b/flang/lib/semantics/check-omp-structure.cc
@@ -13,6 +13,7 @@
 // limitations under the License.
 
 #include "check-omp-structure.h"
+#include "tools.h"
 #include "../parser/parse-tree.h"
 
 namespace Fortran::semantics {
@@ -146,15 +147,32 @@ void OmpStructureChecker::Leave(const parser::OmpClauseList &) {
     }
 
     if (auto *clause{FindClause(OmpClause::ORDERED)}) {
-      if (FindClause(OmpClause::LINEAR)) {
-        // only one ordered clause is allowed
-        const auto &orderedClause{
-            std::get<parser::OmpClause::Ordered>(clause->u)};
-        if (orderedClause.v.has_value()) {
+      // only one ordered clause is allowed
+      const auto &orderedClause{
+          std::get<parser::OmpClause::Ordered>(clause->u)};
+
+      if (orderedClause.v.has_value()) {
+        if (FindClause(OmpClause::LINEAR)) {
           context_.Say(clause->source,
               "A loop directive may not have both a LINEAR clause and "
               "an ORDERED clause with a parameter"_err_en_US);
         }
+
+        if (auto *clause2{FindClause(OmpClause::COLLAPSE)}) {
+          const auto &collapseClause{
+              std::get<parser::OmpClause::Collapse>(clause2->u)};
+          // ordered and collapse both have parameters
+          if (const auto orderedValue{GetIntValue(orderedClause.v)}) {
+            if (const auto collapseValue{GetIntValue(collapseClause.v)}) {
+              if (*orderedValue > 0 && *orderedValue < *collapseValue) {
+                context_.Say(clause->source,
+                    "The parameter of the ORDERED clause must be "
+                    "greater than or equal to "
+                    "the parameter of the COLLAPSE clause"_err_en_US);
+              }
+            }
+          }
+        }
       }
 
       // TODO: ordered region binding check (requires nesting implementation)
@@ -184,9 +202,19 @@ void OmpStructureChecker::Enter(const parser::OmpClause::Notinbranch &) {
 void OmpStructureChecker::Enter(const parser::OmpClause::Untied &) {
   CheckAllowed(OmpClause::UNTIED);
 }
-void OmpStructureChecker::Enter(const parser::OmpClause::Collapse &) {
+
+void OmpStructureChecker::Enter(const parser::OmpClause::Collapse &x) {
   CheckAllowed(OmpClause::COLLAPSE);
+  // collapse clause must have a parameter
+  if (const auto v{GetIntValue(x.v)}) {
+    if (*v <= 0) {
+      context_.Say(GetContext().clauseSource,
+          "The parameter of the COLLAPSE clause must be "
+          "a constant positive integer expression"_err_en_US);
+    }
+  }
 }
+
 void OmpStructureChecker::Enter(const parser::OmpClause::Copyin &) {
   CheckAllowed(OmpClause::COPYIN);
 }
@@ -220,11 +248,30 @@ void OmpStructureChecker::Enter(const parser::OmpClause::NumTasks &) {
 void OmpStructureChecker::Enter(const parser::OmpClause::NumTeams &) {
   CheckAllowed(OmpClause::NUM_TEAMS);
 }
-void OmpStructureChecker::Enter(const parser::OmpClause::NumThreads &) {
+void OmpStructureChecker::Enter(const parser::OmpClause::NumThreads &x) {
   CheckAllowed(OmpClause::NUM_THREADS);
+  if (const auto v{GetIntValue(x.v)}) {
+    if (*v <= 0) {
+      context_.Say(GetContext().clauseSource,
+          "The parameter of the NUM_THREADS clause must be "
+          "a positive integer expression"_err_en_US);
+    }
+  }
+  // if parameter is variable, defer to Expression Analysis
 }
-void OmpStructureChecker::Enter(const parser::OmpClause::Ordered &) {
+
+void OmpStructureChecker::Enter(const parser::OmpClause::Ordered &x) {
   CheckAllowed(OmpClause::ORDERED);
+  // the parameter of ordered clause is optional
+  if (const auto &expr{x.v}) {
+    if (const auto v{GetIntValue(expr)}) {
+      if (*v <= 0) {
+        context_.Say(GetContext().clauseSource,
+            "The parameter of the ORDERED clause must be "
+            "a constant positive integer expression"_err_en_US);
+      }
+    }
+  }
 }
 void OmpStructureChecker::Enter(const parser::OmpClause::Priority &) {
   CheckAllowed(OmpClause::PRIORITY);

diff --git a/flang/lib/semantics/tools.h b/flang/lib/semantics/tools.h
index 8e2eb95..d934931 100644 (file)
--- a/flang/lib/semantics/tools.h
+++ b/flang/lib/semantics/tools.h
@@ -160,5 +160,13 @@ template<typename T> const SomeExpr *GetExpr(const T &x) {
   return GetExprHelper{}.Get(x);
 }
 
+template<typename T> std::optional<std::int64_t> GetIntValue(const T &x) {
+  if (const auto *expr{GetExpr(x)}) {
+    return evaluate::ToInt64(*expr);
+  } else {
+    return std::nullopt;
+  }
+}
+
 }
 #endif  // FORTRAN_SEMANTICS_TOOLS_H_

diff --git a/flang/test/semantics/omp-clause-validity01.f90 b/flang/test/semantics/omp-clause-validity01.f90
index ca2b201..6313c2b 100644 (file)
--- a/flang/test/semantics/omp-clause-validity01.f90
+++ b/flang/test/semantics/omp-clause-validity01.f90
@@ -21,6 +21,7 @@
 !    ...
 
   integer :: b = 128
+  integer, parameter :: num = 16
   N = 1024
 
 ! 2.5 parallel-clause -> if-clause |
@@ -76,6 +77,25 @@
   enddo
   !$omp end parallel
 
+  !ERROR: The parameter of the NUM_THREADS clause must be a positive integer expression
+  !$omp parallel num_threads(1-4)
+  do i = 1, N
+     a = 3.14
+  enddo
+  !$omp end parallel
+
+  !$omp parallel num_threads(num-10)
+  do i = 1, N
+     a = 3.14
+  enddo
+  !$omp end parallel
+
+  !$omp parallel num_threads(b+1)
+  do i = 1, N
+     a = 3.14
+  enddo
+  !$omp end parallel
+
 ! 2.7.1  do-clause -> private-clause |
 !                     firstprivate-clause |
 !                     lastprivate-clause |
@@ -114,11 +134,22 @@
      a = 3.14
   enddo
 
+  !ERROR: The parameter of the ORDERED clause must be a constant positive integer expression
   !ERROR: A loop directive may not have both a LINEAR clause and an ORDERED clause with a parameter
   !ERROR: Internal: no symbol found for 'b'
   !ERROR: Internal: no symbol found for 'a'
-  !$omp do ordered(1) private(b) linear(b) linear(a)
+  !$omp do ordered(1-1) private(b) linear(b) linear(a)
   do i = 1, N
      a = 3.14
   enddo
+
+  !ERROR: The parameter of the ORDERED clause must be greater than or equal to the parameter of the COLLAPSE clause
+  !$omp do collapse(num) ordered(1+2+3+4)
+  do i = 1, N
+     do j = 1, N
+        do k = 1, N
+           a = 3.14
+        enddo
+     enddo
+  enddo
 end