[flang][openacc] parse and ignore non-standard shortloop clause (#106564)

shortloop is a non standard OpenACC extension
(https://docs.nvidia.com/hpc-sdk/pgi-compilers/2015/pgirn157.pdf) that
can be found on loop directives.

f18 parser was choking when seeing it. Since it can be found in existing
apps and is mainly an optimization hint, parse it on loop directives and
ignore it with a warning.

For the records, here is shortloop meaning according to the manual linked above:

"If the shortloop clause appears on a loop directive with the vector clause, it tells the compiler that the
loop trip count is less than or equal to the number of vector lanes created for that loop. This means the
value of the vector() clause on the loop directive in a kernels region, or the value of the
vector_length() clause on the parallel directive in a parallel region will be greater than or
equal to the loop trip count. This allows the compiler to generate more efficient code for the loop"

Author: jeanPerier

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

@@ -769,6 +769,15 @@ void AccStructureChecker::Enter(const parser::AccClause::Link &x) {
   CheckMultipleOccurrenceInDeclare(x.v, llvm::acc::Clause::ACCC_link);
 }
 
+void AccStructureChecker::Enter(const parser::AccClause::Shortloop &x) {
+  if (CheckAllowed(llvm::acc::Clause::ACCC_shortloop) &&
+      context_.languageFeatures().ShouldWarn(
+          common::UsageWarning::OpenAccUsage)) {
+    context_.Say(GetContext().clauseSource,
+        "Non-standard shortloop clause ignored"_warn_en_US);
+  }
+}
+
 void AccStructureChecker::Enter(const parser::AccClause::If &x) {
   CheckAllowed(llvm::acc::Clause::ACCC_if);
   if (const auto *expr{GetExpr(x.v)}) {

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

@@ -354,7 +354,9 @@ class DirectiveStructureChecker : public virtual BaseChecker {
 
   void CheckRequireAtLeastOneOf(bool warnInsteadOfError = false);
 
-  void CheckAllowed(C clause, bool warnInsteadOfError = false);
+  // Check if a clause is allowed on a directive. Returns true if is and
+  // false otherwise.
+  bool CheckAllowed(C clause, bool warnInsteadOfError = false);
 
   // Check that the clause appears only once. The counter is reset when the
   // separator clause appears.
@@ -484,7 +486,7 @@ std::string DirectiveStructureChecker<D, C, PC,
 
 // Check that clauses present on the directive are allowed clauses.
 template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
-void DirectiveStructureChecker<D, C, PC, ClauseEnumSize>::CheckAllowed(
+bool DirectiveStructureChecker<D, C, PC, ClauseEnumSize>::CheckAllowed(
     C clause, bool warnInsteadOfError) {
   if (!GetContext().allowedClauses.test(clause) &&
       !GetContext().allowedOnceClauses.test(clause) &&
@@ -504,7 +506,7 @@ void DirectiveStructureChecker<D, C, PC, ClauseEnumSize>::CheckAllowed(
           parser::ToUpperCaseLetters(getClauseName(clause).str()),
           parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()));
     }
-    return;
+    return false;
   }
   if ((GetContext().allowedOnceClauses.test(clause) ||
           GetContext().allowedExclusiveClauses.test(clause)) &&
@@ -513,7 +515,7 @@ void DirectiveStructureChecker<D, C, PC, ClauseEnumSize>::CheckAllowed(
         "At most one %s clause can appear on the %s directive"_err_en_US,
         parser::ToUpperCaseLetters(getClauseName(clause).str()),
         parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()));
-    return;
+    return false;
   }
   if (GetContext().allowedExclusiveClauses.test(clause)) {
     std::vector<C> others;
@@ -531,12 +533,13 @@ void DirectiveStructureChecker<D, C, PC, ClauseEnumSize>::CheckAllowed(
           parser::ToUpperCaseLetters(GetContext().directiveSource.ToString()));
     }
     if (!others.empty()) {
-      return;
+      return false;
     }
   }
   SetContextClauseInfo(clause);
   AddClauseToCrtContext(clause);
   AddClauseToCrtGroupInContext(clause);
+  return true;
 }
 
 // Enforce restriction where clauses in the given set are not allowed if the

flang/test/Lower/OpenACC/acc-shortloop-ignore.f90

@@ -0,0 +1,57 @@
+! Test that non-standard shortloop clause is accepted and ignored with a
+! warning.
+
+! RUN: %flang_fc1 -fopenacc -emit-hlfir %s -o - 2>&1 | FileCheck %s
+
+! CHECK:  warning: Non-standard shortloop clause ignored
+! CHECK:  warning: Non-standard shortloop clause ignored
+! CHECK:  warning: Non-standard shortloop clause ignored
+! CHECK:  warning: Non-standard shortloop clause ignored
+
+subroutine test_loop(a, b, c)
+  implicit none
+  real, dimension(100) :: a,b,c
+  integer :: i
+  !$acc loop vector shortloop
+  do i=1,100
+    a(i) = b(i) + c(i)
+  enddo
+end subroutine
+! CHECK-LABEL: test_loop
+! CHECK: acc.loop vector
+
+subroutine test_kernels_loop(a, b, c)
+  implicit none
+  real, dimension(100) :: a,b,c
+  integer :: i
+  !$acc kernels loop vector shortloop
+  do i=1,100
+    a(i) = b(i) + c(i)
+  enddo
+end subroutine
+! CHECK-LABEL: test_kernels_loop
+! CHECK: acc.loop combined(kernels) vector
+
+subroutine test_parallel_loop(a, b, c)
+  implicit none
+  real, dimension(100) :: a,b,c
+  integer :: i
+  !$acc parallel loop vector shortloop
+  do i=1,100
+    a(i) = b(i) + c(i)
+  enddo
+end subroutine
+! CHECK-LABEL: test_parallel_loop
+! CHECK: acc.loop combined(parallel) vector
+
+subroutine test_serial_loop(a, b, c)
+  implicit none
+  real, dimension(100) :: a,b,c
+  integer :: i
+  !$acc serial loop vector shortloop
+  do i=1,100
+    a(i) = b(i) + c(i)
+  enddo
+end subroutine
+! CHECK-LABEL: test_serial_loop
+! CHECK: acc.loop combined(serial) vector

flang/test/Semantics/OpenACC/acc-routine-validity.f90

@@ -72,4 +72,11 @@ subroutine sub6(a)
     !$acc routine seq bind(dummy_sub)
   end subroutine sub6
 
+  subroutine sub7(a)
+    real :: a(:)
+    !ERROR: SHORTLOOP clause is not allowed on the KERNELS directive
+    !$acc kernels shortloop
+    !$acc end kernels
+  end subroutine sub7
+
 end module openacc_routine_validity

llvm/include/llvm/Frontend/OpenACC/ACC.td

@@ -229,6 +229,9 @@ def ACCC_Self : Clause<"self"> {
 // 2.9.5
 def ACCC_Seq : Clause<"seq"> {}
 
+// Non-standard extension
+def ACCC_ShortLoop : Clause<"shortloop"> {}
+
 // 2.9.4
 def ACCC_Vector : Clause<"vector"> {
   let flangClass = "ScalarIntExpr";
@@ -407,6 +410,7 @@ def ACC_Loop : Directive<"loop"> {
     VersionedClause<ACCC_Reduction>,
     VersionedClause<ACCC_Collapse>,
     VersionedClause<ACCC_Gang>,
+    VersionedClause<ACCC_ShortLoop>,
     VersionedClause<ACCC_Tile>,
     VersionedClause<ACCC_Vector>,
     VersionedClause<ACCC_Worker>
@@ -583,6 +587,7 @@ def ACC_KernelsLoop : Directive<"kernels loop"> {
     VersionedClause<ACCC_Present>,
     VersionedClause<ACCC_Private>,
     VersionedClause<ACCC_Reduction>,
+    VersionedClause<ACCC_ShortLoop>,
     VersionedClause<ACCC_Tile>,
     VersionedClause<ACCC_Vector>,
     VersionedClause<ACCC_VectorLength>,
@@ -623,6 +628,7 @@ def ACC_ParallelLoop : Directive<"parallel loop"> {
     VersionedClause<ACCC_Present>,
     VersionedClause<ACCC_Private>,
     VersionedClause<ACCC_Reduction>,
+    VersionedClause<ACCC_ShortLoop>,
     VersionedClause<ACCC_Tile>,
     VersionedClause<ACCC_Vector>,
     VersionedClause<ACCC_VectorLength>,
@@ -661,6 +667,7 @@ def ACC_SerialLoop : Directive<"serial loop"> {
     VersionedClause<ACCC_Present>,
     VersionedClause<ACCC_Private>,
     VersionedClause<ACCC_Reduction>,
+    VersionedClause<ACCC_ShortLoop>,
     VersionedClause<ACCC_Tile>,
     VersionedClause<ACCC_Vector>,
     VersionedClause<ACCC_Wait>,