[flang][CUDA] Add error & warning for device argument first dimension… #136058

klausler · 2025-04-16T23:49:11Z

… discontiguity

For dummy assumed-shape/-rank device arrays, test the associated actual argument for stride-1 contiguity, and report an error when the actual argument is known to not be stride-1 contiguous and nonempty, or a warning when when the actual argument is not known to be empty or stride-1 contiguous.

… discontiguity For dummy assumed-shape/-rank device arrays, test the associated actual argument for stride-1 contiguity, and report an error when the actual argument is known to not be stride-1 contiguous and nonempty, or a warning when when the actual argument is not known to be empty or stride-1 contiguous.

llvmbot · 2025-04-16T23:49:46Z

@llvm/pr-subscribers-flang-semantics

Author: Peter Klausler (klausler)

Changes

… discontiguity

For dummy assumed-shape/-rank device arrays, test the associated actual argument for stride-1 contiguity, and report an error when the actual argument is known to not be stride-1 contiguous and nonempty, or a warning when when the actual argument is not known to be empty or stride-1 contiguous.

Full diff: https://github.com/llvm/llvm-project/pull/136058.diff

4 Files Affected:

(modified) flang/include/flang/Evaluate/check-expression.h (+17-9)
(modified) flang/lib/Evaluate/check-expression.cpp (+53-34)
(modified) flang/lib/Semantics/check-call.cpp (+18-2)
(added) flang/test/Semantics/cuf19.cuf (+30)

diff --git a/flang/include/flang/Evaluate/check-expression.h b/flang/include/flang/Evaluate/check-expression.h
index 7eee1994a888c..0cf12f340ec5c 100644
--- a/flang/include/flang/Evaluate/check-expression.h
+++ b/flang/include/flang/Evaluate/check-expression.h
@@ -113,21 +113,29 @@ extern template void CheckSpecificationExpr(
 // read-only data.
 template <typename A>
 std::optional<bool> IsContiguous(const A &, FoldingContext &,
-    bool namedConstantSectionsAreContiguous = true);
+    bool namedConstantSectionsAreContiguous = true,
+    bool firstDimensionStride1 = false);
 extern template std::optional<bool> IsContiguous(const Expr<SomeType> &,
-    FoldingContext &, bool namedConstantSectionsAreContiguous);
+    FoldingContext &, bool namedConstantSectionsAreContiguous,
+    bool firstDimensionStride1);
 extern template std::optional<bool> IsContiguous(const ArrayRef &,
-    FoldingContext &, bool namedConstantSectionsAreContiguous);
+    FoldingContext &, bool namedConstantSectionsAreContiguous,
+    bool firstDimensionStride1);
 extern template std::optional<bool> IsContiguous(const Substring &,
-    FoldingContext &, bool namedConstantSectionsAreContiguous);
+    FoldingContext &, bool namedConstantSectionsAreContiguous,
+    bool firstDimensionStride1);
 extern template std::optional<bool> IsContiguous(const Component &,
-    FoldingContext &, bool namedConstantSectionsAreContiguous);
+    FoldingContext &, bool namedConstantSectionsAreContiguous,
+    bool firstDimensionStride1);
 extern template std::optional<bool> IsContiguous(const ComplexPart &,
-    FoldingContext &, bool namedConstantSectionsAreContiguous);
+    FoldingContext &, bool namedConstantSectionsAreContiguous,
+    bool firstDimensionStride1);
 extern template std::optional<bool> IsContiguous(const CoarrayRef &,
-    FoldingContext &, bool namedConstantSectionsAreContiguous);
-extern template std::optional<bool> IsContiguous(
-    const Symbol &, FoldingContext &, bool namedConstantSectionsAreContiguous);
+    FoldingContext &, bool namedConstantSectionsAreContiguous,
+    bool firstDimensionStride1);
+extern template std::optional<bool> IsContiguous(const Symbol &,
+    FoldingContext &, bool namedConstantSectionsAreContiguous,
+    bool firstDimensionStride1);
 static inline std::optional<bool> IsContiguous(const SymbolRef &s,
     FoldingContext &c, bool namedConstantSectionsAreContiguous = true) {
   return IsContiguous(s.get(), c, namedConstantSectionsAreContiguous);
diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp
index 78268cd13377a..d8baaf2e2a7ac 100644
--- a/flang/lib/Evaluate/check-expression.cpp
+++ b/flang/lib/Evaluate/check-expression.cpp
@@ -881,10 +881,12 @@ class IsContiguousHelper
 public:
   using Result = std::optional<bool>; // tri-state
   using Base = AnyTraverse<IsContiguousHelper, Result>;
-  explicit IsContiguousHelper(
-      FoldingContext &c, bool namedConstantSectionsAreContiguous)
-      : Base{*this}, context_{c}, namedConstantSectionsAreContiguous_{
-                                      namedConstantSectionsAreContiguous} {}
+  explicit IsContiguousHelper(FoldingContext &c,
+      bool namedConstantSectionsAreContiguous,
+      bool firstDimensionStride1 = false)
+      : Base{*this}, context_{c},
+        namedConstantSectionsAreContiguous_{namedConstantSectionsAreContiguous},
+        firstDimensionStride1_{firstDimensionStride1} {}
   using Base::operator();
 
   template <typename T> Result operator()(const Constant<T> &) const {
@@ -956,13 +958,14 @@ class IsContiguousHelper
         if (!*baseIsContiguous) {
           return false;
         }
-        // TODO could be true if base contiguous and this is only component, or
-        // if base has only one element?
+        // TODO: should be true if base is contiguous and this is only
+        // component, or when the base has at most one element
       }
       return std::nullopt;
     }
   }
   Result operator()(const ComplexPart &x) const {
+    // TODO: should be true when base is empty array, too
     return x.complex().Rank() == 0;
   }
   Result operator()(const Substring &x) const {
@@ -1061,6 +1064,9 @@ class IsContiguousHelper
     auto dims{subscript.size()};
     std::vector<bool> knownPartialSlice(dims, false);
     for (auto j{dims}; j-- > 0;) {
+      if (j == 0 && firstDimensionStride1_ && !result.value_or(true)) {
+        result.reset(); // ignore problems on later dimensions
+      }
       std::optional<ConstantSubscript> dimLbound;
       std::optional<ConstantSubscript> dimUbound;
       std::optional<ConstantSubscript> dimExtent;
@@ -1083,18 +1089,20 @@ class IsContiguousHelper
           dimExtent = 0;
         }
       }
-
       if (const auto *triplet{std::get_if<Triplet>(&subscript[j].u)}) {
         ++rank;
+        const Expr<SubscriptInteger> *lowerBound{triplet->GetLower()};
+        const Expr<SubscriptInteger> *upperBound{triplet->GetUpper()};
+        std::optional<ConstantSubscript> lowerVal{lowerBound
+                ? ToInt64(Fold(context_, Expr<SubscriptInteger>{*lowerBound}))
+                : dimLbound};
+        std::optional<ConstantSubscript> upperVal{upperBound
+                ? ToInt64(Fold(context_, Expr<SubscriptInteger>{*upperBound}))
+                : dimUbound};
         if (auto stride{ToInt64(triplet->stride())}) {
-          const Expr<SubscriptInteger> *lowerBound{triplet->GetLower()};
-          const Expr<SubscriptInteger> *upperBound{triplet->GetUpper()};
-          std::optional<ConstantSubscript> lowerVal{lowerBound
-                  ? ToInt64(Fold(context_, Expr<SubscriptInteger>{*lowerBound}))
-                  : dimLbound};
-          std::optional<ConstantSubscript> upperVal{upperBound
-                  ? ToInt64(Fold(context_, Expr<SubscriptInteger>{*upperBound}))
-                  : dimUbound};
+          if (j == 0 && *stride == 1 && firstDimensionStride1_) {
+            result = *stride == 1; // contiguous or empty if so
+          }
           if (lowerVal && upperVal) {
             if (*lowerVal < *upperVal) {
               if (*stride < 0) {
@@ -1110,23 +1118,31 @@ class IsContiguousHelper
                   *lowerVal + *stride >= *upperVal) {
                 result = false; // discontiguous if not empty
               }
-            } else {
-              mayBeEmpty = true;
+            } else { // bounds known and equal
+              if (j == 0 && firstDimensionStride1_) {
+                result = true; // stride doesn't matter
+              }
+            }
+          } else { // bounds not both known
+            mayBeEmpty = true;
+          }
+        } else { // stride not known
+          if (lowerVal && upperVal && *lowerVal == *upperVal) {
+            // stride doesn't matter when bounds are equal
+            if (j == 0 && firstDimensionStride1_) {
+              result = true;
             }
           } else {
             mayBeEmpty = true;
           }
-        } else {
-          mayBeEmpty = true;
         }
-      } else if (subscript[j].Rank() > 0) {
+      } else if (subscript[j].Rank() > 0) { // vector subscript
         ++rank;
         if (!result) {
-          result = false; // vector subscript
+          result = false;
         }
         mayBeEmpty = true;
-      } else {
-        // Scalar subscript.
+      } else { // scalar subscript
         if (dimExtent && *dimExtent > 1) {
           knownPartialSlice[j] = true;
         }
@@ -1138,7 +1154,7 @@ class IsContiguousHelper
     if (result) {
       return result;
     }
-    // Not provably discontiguous at this point.
+    // Not provably contiguous or discontiguous at this point.
     // Return "true" if simply contiguous, otherwise nullopt.
     for (auto j{subscript.size()}; j-- > 0;) {
       if (const auto *triplet{std::get_if<Triplet>(&subscript[j].u)}) {
@@ -1170,33 +1186,36 @@ class IsContiguousHelper
 
   FoldingContext &context_;
   bool namedConstantSectionsAreContiguous_{false};
+  bool firstDimensionStride1_{false};
 };
 
 template <typename A>
 std::optional<bool> IsContiguous(const A &x, FoldingContext &context,
-    bool namedConstantSectionsAreContiguous) {
+    bool namedConstantSectionsAreContiguous, bool firstDimensionStride1) {
   if (!IsVariable(x) &&
       (namedConstantSectionsAreContiguous || !ExtractDataRef(x, true, true))) {
     return true;
   } else {
-    return IsContiguousHelper{context, namedConstantSectionsAreContiguous}(x);
+    return IsContiguousHelper{
+        context, namedConstantSectionsAreContiguous, firstDimensionStride1}(x);
   }
 }
 
 template std::optional<bool> IsContiguous(const Expr<SomeType> &,
-    FoldingContext &, bool namedConstantSectionsAreContiguous);
+    FoldingContext &, bool namedConstantSectionsAreContiguous,
+    bool firstDimensionStride1);
 template std::optional<bool> IsContiguous(const ArrayRef &, FoldingContext &,
-    bool namedConstantSectionsAreContiguous);
+    bool namedConstantSectionsAreContiguous, bool firstDimensionStride1);
 template std::optional<bool> IsContiguous(const Substring &, FoldingContext &,
-    bool namedConstantSectionsAreContiguous);
+    bool namedConstantSectionsAreContiguous, bool firstDimensionStride1);
 template std::optional<bool> IsContiguous(const Component &, FoldingContext &,
-    bool namedConstantSectionsAreContiguous);
+    bool namedConstantSectionsAreContiguous, bool firstDimensionStride1);
 template std::optional<bool> IsContiguous(const ComplexPart &, FoldingContext &,
-    bool namedConstantSectionsAreContiguous);
+    bool namedConstantSectionsAreContiguous, bool firstDimensionStride1);
 template std::optional<bool> IsContiguous(const CoarrayRef &, FoldingContext &,
-    bool namedConstantSectionsAreContiguous);
-template std::optional<bool> IsContiguous(
-    const Symbol &, FoldingContext &, bool namedConstantSectionsAreContiguous);
+    bool namedConstantSectionsAreContiguous, bool firstDimensionStride1);
+template std::optional<bool> IsContiguous(const Symbol &, FoldingContext &,
+    bool namedConstantSectionsAreContiguous, bool firstDimensionStride1);
 
 // IsErrorExpr()
 struct IsErrorExprHelper : public AnyTraverse<IsErrorExprHelper, bool> {
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index ef8282143451c..dfaa0e028d698 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -1015,10 +1015,26 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
         actualDataAttr = common::CUDADataAttr::Device;
       }
     }
+    if (dummyDataAttr == common::CUDADataAttr::Device &&
+        (dummyIsAssumedShape || dummyIsAssumedRank)) {
+      if (auto contig{evaluate::IsContiguous(actual, foldingContext,
+              /*namedConstantSectionsAreContiguous=*/true,
+              /*firstDimensionStride1=*/true)}) {
+        if (!*contig) {
+          messages.Say(
+              "actual argument associated with assumed shape/rank device %s is known to be discontiguous on its first dimension"_err_en_US,
+              dummyName);
+        }
+      } else {
+        messages.Say(
+            "actual argument associated with assumed shape/rank device %s is not known to be contiguous on its first dimension"_warn_en_US,
+            dummyName);
+      }
+    }
     std::optional<std::string> warning;
-    bool isHostDeviceProc = procedure.cudaSubprogramAttrs &&
+    bool isHostDeviceProc{procedure.cudaSubprogramAttrs &&
         *procedure.cudaSubprogramAttrs ==
-            common::CUDASubprogramAttrs::HostDevice;
+            common::CUDASubprogramAttrs::HostDevice};
     if (!common::AreCompatibleCUDADataAttrs(dummyDataAttr, actualDataAttr,
             dummy.ignoreTKR, &warning, /*allowUnifiedMatchingRule=*/true,
             isHostDeviceProc, &context.languageFeatures())) {
diff --git a/flang/test/Semantics/cuf19.cuf b/flang/test/Semantics/cuf19.cuf
new file mode 100644
index 0000000000000..8bec943f99006
--- /dev/null
+++ b/flang/test/Semantics/cuf19.cuf
@@ -0,0 +1,30 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+interface
+  subroutine foo(a)
+    real, device, dimension(:,:) :: a
+  end
+end interface
+
+real, device, allocatable :: a(:,:)
+complex, device, allocatable :: z(:,:)
+integer :: i = 2, j = 3
+allocate(a(10,10))
+allocate(z(10,10))
+call foo(a) ! ok
+call foo(a(:,:)) ! ok
+call foo(a(1:10,1:10)) ! ok
+!ERROR: actual argument associated with assumed shape/rank device dummy argument 'a=' is known to be discontiguous on its first dimension
+call foo(a(1:10:2,1:10))
+call foo(a(1:0:2,1:10)) ! empty dimension is ok
+call foo(a(1:10:2,1:0)) ! any empty dimension is ok
+call foo(a(1:10,1:10:2)) ! discontiguous second dimension is ok
+!WARNING: actual argument associated with assumed shape/rank device dummy argument 'a=' is not known to be contiguous on its first dimension
+call foo(a(1:10:i,1:10))
+!WARNING: actual argument associated with assumed shape/rank device dummy argument 'a=' is not known to be contiguous on its first dimension
+call foo(a(1:i:2,1:10))
+call foo(a(i:j:1,1:10)) ! stride 1, okay, despite unknown bounds
+!WARNING: actual argument associated with assumed shape/rank device dummy argument 'a=' is not known to be contiguous on its first dimension
+call foo(a(i:j:-1,1:10))
+!ERROR: actual argument associated with assumed shape/rank device dummy argument 'a=' is known to be discontiguous on its first dimension
+call foo(z%re)
+end

clementval

LGTM. Thanks

llvm#136058) … discontiguity For dummy assumed-shape/-rank device arrays, test the associated actual argument for stride-1 contiguity, and report an error when the actual argument is known to not be stride-1 contiguous and nonempty, or a warning when when the actual argument is not known to be empty or stride-1 contiguous.

klausler requested review from clementval, akuhlens and eugeneepshteyn April 16, 2025 23:49

llvmbot added flang Flang issues not falling into any other category flang:semantics labels Apr 16, 2025

clementval approved these changes Apr 17, 2025

View reviewed changes

klausler merged commit 5449408 into llvm:main Apr 18, 2025
14 checks passed

klausler deleted the contiguous-device branch April 18, 2025 19:51

xlauko mentioned this pull request Apr 18, 2025

LowerGlobalDtors: Use use_empty instead of getNumUses == 0 (#136337) #136361

Closed

Provide feedback

Saved searches

Use saved searches to filter your results more quickly

Uh oh!

[flang][CUDA] Add error & warning for device argument first dimension… #136058

[flang][CUDA] Add error & warning for device argument first dimension… #136058

Uh oh!

klausler commented Apr 16, 2025

Uh oh!

llvmbot commented Apr 16, 2025

Uh oh!

clementval left a comment

Uh oh!

Uh oh!

Uh oh!

[flang][CUDA] Add error & warning for device argument first dimension… #136058

[flang][CUDA] Add error & warning for device argument first dimension… #136058

Uh oh!

Conversation

klausler commented Apr 16, 2025

Uh oh!

llvmbot commented Apr 16, 2025

Uh oh!

clementval left a comment

Choose a reason for hiding this comment

Uh oh!

Uh oh!

Uh oh!