Skip to content

Commit 7e013d6

Browse files
authored
[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 #65046.
1 parent f8ced20 commit 7e013d6

File tree

3 files changed

+45
-26
lines changed

3 files changed

+45
-26
lines changed

flang/lib/Evaluate/check-expression.cpp

Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -114,6 +114,7 @@ bool IsConstantExprHelper<INVARIANT>::operator()(
114114
// LBOUND, UBOUND, and SIZE with truly constant DIM= arguments will have
115115
// been rewritten into DescriptorInquiry operations.
116116
if (const auto *intrinsic{std::get_if<SpecificIntrinsic>(&call.proc().u)}) {
117+
const characteristics::Procedure &proc{intrinsic->characteristics.value()};
117118
if (intrinsic->name == "kind" ||
118119
intrinsic->name == IntrinsicProcTable::InvalidName ||
119120
call.arguments().empty() || !call.arguments()[0]) {
@@ -129,6 +130,16 @@ bool IsConstantExprHelper<INVARIANT>::operator()(
129130
} else if (intrinsic->name == "shape" || intrinsic->name == "size") {
130131
auto shape{GetShape(call.arguments()[0]->UnwrapExpr())};
131132
return shape && IsConstantExprShape(*shape);
133+
} else if (proc.IsPure()) {
134+
for (const auto &arg : call.arguments()) {
135+
if (!arg) {
136+
return false;
137+
} else if (const auto *expr{arg->UnwrapExpr()};
138+
!expr || !(*this)(*expr)) {
139+
return false;
140+
}
141+
}
142+
return true;
132143
}
133144
// TODO: STORAGE_SIZE
134145
}

flang/lib/Semantics/check-data.cpp

Lines changed: 30 additions & 26 deletions
Original file line numberDiff line numberDiff line change
@@ -102,16 +102,16 @@ class DataVarChecker : public evaluate::AllTraverse<DataVarChecker, true> {
102102
lastSymbol.name().ToString());
103103
return false;
104104
}
105-
RestrictPointer();
105+
auto restorer{common::ScopedSet(isPointerAllowed_, false)};
106+
return (*this)(component.base()) && (*this)(lastSymbol);
107+
} else if (IsPointer(lastSymbol)) { // C877
108+
context_.Say(source_,
109+
"Data object must not contain pointer '%s' as a non-rightmost part"_err_en_US,
110+
lastSymbol.name().ToString());
111+
return false;
106112
} else {
107-
if (IsPointer(lastSymbol)) { // C877
108-
context_.Say(source_,
109-
"Data object must not contain pointer '%s' as a non-rightmost part"_err_en_US,
110-
lastSymbol.name().ToString());
111-
return false;
112-
}
113+
return (*this)(component.base()) && (*this)(lastSymbol);
113114
}
114-
return (*this)(component.base()) && (*this)(lastSymbol);
115115
}
116116
bool operator()(const evaluate::ArrayRef &arrayRef) {
117117
hasSubscript_ = true;
@@ -128,29 +128,32 @@ class DataVarChecker : public evaluate::AllTraverse<DataVarChecker, true> {
128128
return false;
129129
}
130130
bool operator()(const evaluate::Subscript &subs) {
131-
DataVarChecker subscriptChecker{context_, source_};
132-
subscriptChecker.RestrictPointer();
131+
auto restorer1{common::ScopedSet(isPointerAllowed_, false)};
132+
auto restorer2{common::ScopedSet(isFunctionAllowed_, true)};
133133
return common::visit(
134-
common::visitors{
135-
[&](const evaluate::IndirectSubscriptIntegerExpr &expr) {
136-
return CheckSubscriptExpr(expr);
137-
},
138-
[&](const evaluate::Triplet &triplet) {
139-
return CheckSubscriptExpr(triplet.lower()) &&
140-
CheckSubscriptExpr(triplet.upper()) &&
141-
CheckSubscriptExpr(triplet.stride());
142-
},
143-
},
144-
subs.u) &&
145-
subscriptChecker(subs.u);
134+
common::visitors{
135+
[&](const evaluate::IndirectSubscriptIntegerExpr &expr) {
136+
return CheckSubscriptExpr(expr);
137+
},
138+
[&](const evaluate::Triplet &triplet) {
139+
return CheckSubscriptExpr(triplet.lower()) &&
140+
CheckSubscriptExpr(triplet.upper()) &&
141+
CheckSubscriptExpr(triplet.stride());
142+
},
143+
},
144+
subs.u);
146145
}
147146
template <typename T>
148147
bool operator()(const evaluate::FunctionRef<T> &) const { // C875
149-
context_.Say(source_,
150-
"Data object variable must not be a function reference"_err_en_US);
151-
return false;
148+
if (isFunctionAllowed_) {
149+
// Must have been validated as a constant expression
150+
return true;
151+
} else {
152+
context_.Say(source_,
153+
"Data object variable must not be a function reference"_err_en_US);
154+
return false;
155+
}
152156
}
153-
void RestrictPointer() { isPointerAllowed_ = false; }
154157

155158
private:
156159
bool CheckSubscriptExpr(
@@ -178,6 +181,7 @@ class DataVarChecker : public evaluate::AllTraverse<DataVarChecker, true> {
178181
bool hasSubscript_{false};
179182
bool isPointerAllowed_{true};
180183
bool isFirstSymbol_{true};
184+
bool isFunctionAllowed_{false};
181185
};
182186

183187
static bool IsValidDataObject(const SomeExpr &expr) { // C878, C879

flang/test/Semantics/data05.f90

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -93,4 +93,8 @@ subroutine s13
9393
integer j(2)
9494
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]
9595
end subroutine
96+
subroutine s14
97+
integer j(0:1)
98+
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]
99+
end subroutine
96100
end module

0 commit comments

Comments
 (0)