[flang-commits] [flang] 7e013d6 - [flang] Accept intrinsic functions in DATA statement variables (#66229)

[via flang-commits]

Author: Peter Klausler
Date: 2023-09-13T15:02:11-07:00
New Revision: 7e013d6034bd8e81a6434f515f545b4375078512

URL: https://github.com/llvm/llvm-project/commit/7e013d6034bd8e81a6434f515f545b4375078512
DIFF: https://github.com/llvm/llvm-project/commit/7e013d6034bd8e81a6434f515f545b4375078512.diff

LOG: [flang] Accept intrinsic functions in DATA statement variables (#66229)

Pure intrinsic functions are acceptable in constant expressions so long
as their arguments are constant expressions. Allow them to appear in
subscripts in DATA statement variables.

Fixes https://github.com/llvm/llvm-project/issues/65046.

Added: 
    

Modified: 
    flang/lib/Evaluate/check-expression.cpp
    flang/lib/Semantics/check-data.cpp
    flang/test/Semantics/data05.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp
index cfc67bf70dd0d63..29bd6eaa466bbc2 100644
--- a/flang/lib/Evaluate/check-expression.cpp
+++ b/flang/lib/Evaluate/check-expression.cpp
@@ -114,6 +114,7 @@ bool IsConstantExprHelper<INVARIANT>::operator()(
   // LBOUND, UBOUND, and SIZE with truly constant DIM= arguments will have
   // been rewritten into DescriptorInquiry operations.
   if (const auto *intrinsic{std::get_if<SpecificIntrinsic>(&call.proc().u)}) {
+    const characteristics::Procedure &proc{intrinsic->characteristics.value()};
     if (intrinsic->name == "kind" ||
         intrinsic->name == IntrinsicProcTable::InvalidName ||
         call.arguments().empty() || !call.arguments()[0]) {
@@ -129,6 +130,16 @@ bool IsConstantExprHelper<INVARIANT>::operator()(
     } else if (intrinsic->name == "shape" || intrinsic->name == "size") {
       auto shape{GetShape(call.arguments()[0]->UnwrapExpr())};
       return shape && IsConstantExprShape(*shape);
+    } else if (proc.IsPure()) {
+      for (const auto &arg : call.arguments()) {
+        if (!arg) {
+          return false;
+        } else if (const auto *expr{arg->UnwrapExpr()};
+                   !expr || !(*this)(*expr)) {
+          return false;
+        }
+      }
+      return true;
     }
     // TODO: STORAGE_SIZE
   }

diff  --git a/flang/lib/Semantics/check-data.cpp b/flang/lib/Semantics/check-data.cpp
index 6916870907a63aa..72e021d03a96974 100644
--- a/flang/lib/Semantics/check-data.cpp
+++ b/flang/lib/Semantics/check-data.cpp
@@ -102,16 +102,16 @@ class DataVarChecker : public evaluate::AllTraverse<DataVarChecker, true> {
             lastSymbol.name().ToString());
         return false;
       }
-      RestrictPointer();
+      auto restorer{common::ScopedSet(isPointerAllowed_, false)};
+      return (*this)(component.base()) && (*this)(lastSymbol);
+    } else if (IsPointer(lastSymbol)) { // C877
+      context_.Say(source_,
+          "Data object must not contain pointer '%s' as a non-rightmost part"_err_en_US,
+          lastSymbol.name().ToString());
+      return false;
     } else {
-      if (IsPointer(lastSymbol)) { // C877
-        context_.Say(source_,
-            "Data object must not contain pointer '%s' as a non-rightmost part"_err_en_US,
-            lastSymbol.name().ToString());
-        return false;
-      }
+      return (*this)(component.base()) && (*this)(lastSymbol);
     }
-    return (*this)(component.base()) && (*this)(lastSymbol);
   }
   bool operator()(const evaluate::ArrayRef &arrayRef) {
     hasSubscript_ = true;
@@ -128,29 +128,32 @@ class DataVarChecker : public evaluate::AllTraverse<DataVarChecker, true> {
     return false;
   }
   bool operator()(const evaluate::Subscript &subs) {
-    DataVarChecker subscriptChecker{context_, source_};
-    subscriptChecker.RestrictPointer();
+    auto restorer1{common::ScopedSet(isPointerAllowed_, false)};
+    auto restorer2{common::ScopedSet(isFunctionAllowed_, true)};
     return common::visit(
-               common::visitors{
-                   [&](const evaluate::IndirectSubscriptIntegerExpr &expr) {
-                     return CheckSubscriptExpr(expr);
-                   },
-                   [&](const evaluate::Triplet &triplet) {
-                     return CheckSubscriptExpr(triplet.lower()) &&
-                         CheckSubscriptExpr(triplet.upper()) &&
-                         CheckSubscriptExpr(triplet.stride());
-                   },
-               },
-               subs.u) &&
-        subscriptChecker(subs.u);
+        common::visitors{
+            [&](const evaluate::IndirectSubscriptIntegerExpr &expr) {
+              return CheckSubscriptExpr(expr);
+            },
+            [&](const evaluate::Triplet &triplet) {
+              return CheckSubscriptExpr(triplet.lower()) &&
+                  CheckSubscriptExpr(triplet.upper()) &&
+                  CheckSubscriptExpr(triplet.stride());
+            },
+        },
+        subs.u);
   }
   template <typename T>
   bool operator()(const evaluate::FunctionRef<T> &) const { // C875
-    context_.Say(source_,
-        "Data object variable must not be a function reference"_err_en_US);
-    return false;
+    if (isFunctionAllowed_) {
+      // Must have been validated as a constant expression
+      return true;
+    } else {
+      context_.Say(source_,
+          "Data object variable must not be a function reference"_err_en_US);
+      return false;
+    }
   }
-  void RestrictPointer() { isPointerAllowed_ = false; }
 
 private:
   bool CheckSubscriptExpr(
@@ -178,6 +181,7 @@ class DataVarChecker : public evaluate::AllTraverse<DataVarChecker, true> {
   bool hasSubscript_{false};
   bool isPointerAllowed_{true};
   bool isFirstSymbol_{true};
+  bool isFunctionAllowed_{false};
 };
 
 static bool IsValidDataObject(const SomeExpr &expr) { // C878, C879

diff  --git a/flang/test/Semantics/data05.f90 b/flang/test/Semantics/data05.f90
index 02bfd4663264597..f9fc858c8d54398 100644
--- a/flang/test/Semantics/data05.f90
+++ b/flang/test/Semantics/data05.f90
@@ -93,4 +93,8 @@ subroutine s13
     integer j(2)
     data j(2:1), j(1:2) /1,2/ ! CHECK: j (InDataStmt) size=8 offset=0: ObjectEntity type: INTEGER(4) shape: 1_8:2_8 init:[INTEGER(4)::1_4,2_4]
   end subroutine
+  subroutine s14
+    integer j(0:1)
+    data (j(modulo(k,2)),k=1,2) /3,4/ ! CHECK: j (InDataStmt) size=8 offset=0: ObjectEntity type: INTEGER(4) shape: 0_8:1_8 init:[INTEGER(4)::4_4,3_4]
+  end subroutine
 end module