diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp index cfc67bf70dd0d..29bd6eaa466bb 100644 --- a/flang/lib/Evaluate/check-expression.cpp +++ b/flang/lib/Evaluate/check-expression.cpp @@ -114,6 +114,7 @@ bool IsConstantExprHelper::operator()( // LBOUND, UBOUND, and SIZE with truly constant DIM= arguments will have // been rewritten into DescriptorInquiry operations. if (const auto *intrinsic{std::get_if(&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::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 6916870907a63..72e021d03a969 100644 --- a/flang/lib/Semantics/check-data.cpp +++ b/flang/lib/Semantics/check-data.cpp @@ -102,16 +102,16 @@ class DataVarChecker : public evaluate::AllTraverse { 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 { 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 bool operator()(const evaluate::FunctionRef &) 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 { 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 02bfd46632645..f9fc858c8d543 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