[flang-commits] [flang] 5d5d2a0 - [flang] Refine error checking in specification expressions
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Mon May 9 17:55:02 PDT 2022
Author: Peter Klausler
Date: 2022-05-09T17:50:12-07:00
New Revision: 5d5d2a0b197fa02abac5ccf295731ca826864ddd
URL: https://github.com/llvm/llvm-project/commit/5d5d2a0b197fa02abac5ccf295731ca826864ddd
DIFF: https://github.com/llvm/llvm-project/commit/5d5d2a0b197fa02abac5ccf295731ca826864ddd.diff
LOG: [flang] Refine error checking in specification expressions
The rules in the Fortran standard for specification expressions
are full of special cases and exceptions, and semantics didn't get
them exactly right. It is valid to refer to an INTENT(OUT) dummy
argument in a specification expression in the context of a
specification inquiry function like SIZE(); it is not valid to
reference an OPTIONAL dummy argument outside of the context of
PRESENT. This patch makes the specification expression checker
a little context-sensitive about whether it's examining an actual
argument of a specification inquiry intrinsic function or not.
Differential Revision: https://reviews.llvm.org/D125131
Added:
Modified:
flang/lib/Evaluate/check-expression.cpp
flang/lib/Evaluate/intrinsics.cpp
flang/test/Semantics/spec-expr.f90
flang/test/Semantics/symbol13.f90
Removed:
################################################################################
diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp
index 588fe3b60929..13b48a2cd2e8 100644
--- a/flang/lib/Evaluate/check-expression.cpp
+++ b/flang/lib/Evaluate/check-expression.cpp
@@ -48,7 +48,7 @@ class IsConstantExprHelper
return IsNamedConstant(ultimate) || IsImpliedDoIndex(ultimate) ||
IsInitialProcedureTarget(ultimate) ||
ultimate.has<semantics::TypeParamDetails>() ||
- (INVARIANT && IsIntentIn(symbol) &&
+ (INVARIANT && IsIntentIn(symbol) && !IsOptional(symbol) &&
!symbol.attrs().test(semantics::Attr::VALUE));
}
bool operator()(const CoarrayRef &) const { return false; }
@@ -84,7 +84,8 @@ class IsConstantExprHelper
const Symbol &sym{x.base().GetLastSymbol()};
return INVARIANT && !IsAllocatable(sym) &&
(!IsDummy(sym) ||
- (IsIntentIn(sym) && !sym.attrs().test(semantics::Attr::VALUE)));
+ (IsIntentIn(sym) && !IsOptional(sym) &&
+ !sym.attrs().test(semantics::Attr::VALUE)));
}
private:
@@ -109,27 +110,21 @@ bool IsConstantExprHelper<INVARIANT>::IsConstantStructureConstructorComponent(
template <bool INVARIANT>
bool IsConstantExprHelper<INVARIANT>::operator()(
const ProcedureRef &call) const {
- // LBOUND, UBOUND, and SIZE with DIM= arguments will have been rewritten
- // into DescriptorInquiry operations.
+ // 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)}) {
if (intrinsic->name == "kind" ||
intrinsic->name == IntrinsicProcTable::InvalidName) {
// kind is always a constant, and we avoid cascading errors by considering
// invalid calls to intrinsics to be constant
return true;
- } else if (intrinsic->name == "lbound" && call.arguments().size() == 1) {
- // LBOUND(x) without DIM=
+ } else if (intrinsic->name == "lbound") {
auto base{ExtractNamedEntity(call.arguments()[0]->UnwrapExpr())};
return base && IsConstantExprShape(GetLBOUNDs(*base));
- } else if (intrinsic->name == "ubound" && call.arguments().size() == 1) {
- // UBOUND(x) without DIM=
+ } else if (intrinsic->name == "ubound") {
auto base{ExtractNamedEntity(call.arguments()[0]->UnwrapExpr())};
return base && IsConstantExprShape(GetUBOUNDs(*base));
- } else if (intrinsic->name == "shape") {
- auto shape{GetShape(call.arguments()[0]->UnwrapExpr())};
- return shape && IsConstantExprShape(*shape);
- } else if (intrinsic->name == "size" && call.arguments().size() == 1) {
- // SIZE(x) without DIM
+ } else if (intrinsic->name == "shape" || intrinsic->name == "size") {
auto shape{GetShape(call.arguments()[0]->UnwrapExpr())};
return shape && IsConstantExprShape(*shape);
}
@@ -527,7 +522,8 @@ class CheckSpecificationExprHelper
if (ultimate.attrs().test(semantics::Attr::OPTIONAL)) {
return "reference to OPTIONAL dummy argument '"s +
ultimate.name().ToString() + "'";
- } else if (ultimate.attrs().test(semantics::Attr::INTENT_OUT)) {
+ } else if (!inInquiry_ &&
+ ultimate.attrs().test(semantics::Attr::INTENT_OUT)) {
return "reference to INTENT(OUT) dummy argument '"s +
ultimate.name().ToString() + "'";
} else if (ultimate.has<semantics::ObjectEntityDetails>()) {
@@ -550,11 +546,33 @@ class CheckSpecificationExprHelper
// Don't look at the component symbol.
return (*this)(x.base());
}
- Result operator()(const DescriptorInquiry &) const {
- // Subtle: Uses of SIZE(), LBOUND(), &c. that are valid in specification
+ Result operator()(const ArrayRef &x) const {
+ if (auto result{(*this)(x.base())}) {
+ return result;
+ }
+ // The subscripts don't get special protection for being in a
+ // specification inquiry context;
+ auto restorer{common::ScopedSet(inInquiry_, false)};
+ return (*this)(x.subscript());
+ }
+ Result operator()(const Substring &x) const {
+ if (auto result{(*this)(x.parent())}) {
+ return result;
+ }
+ // The bounds don't get special protection for being in a
+ // specification inquiry context;
+ auto restorer{common::ScopedSet(inInquiry_, false)};
+ if (auto result{(*this)(x.lower())}) {
+ return result;
+ }
+ return (*this)(x.upper());
+ }
+ Result operator()(const DescriptorInquiry &x) const {
+ // Many uses of SIZE(), LBOUND(), &c. that are valid in specification
// expressions will have been converted to expressions over descriptor
// inquiries by Fold().
- return std::nullopt;
+ auto restorer{common::ScopedSet(inInquiry_, true)};
+ return (*this)(x.base());
}
Result operator()(const TypeParamInquiry &inq) const {
@@ -567,6 +585,7 @@ class CheckSpecificationExprHelper
}
Result operator()(const ProcedureRef &x) const {
+ bool inInquiry{false};
if (const auto *symbol{x.proc().GetSymbol()}) {
const Symbol &ultimate{symbol->GetUltimate()};
if (!semantics::IsPureProcedure(ultimate)) {
@@ -599,40 +618,44 @@ class CheckSpecificationExprHelper
// TODO: other checks for standard module procedures
} else {
const SpecificIntrinsic &intrin{DEREF(x.proc().GetSpecificIntrinsic())};
+ inInquiry = context_.intrinsics().GetIntrinsicClass(intrin.name) ==
+ IntrinsicClass::inquiryFunction;
if (scope_.IsDerivedType()) { // C750, C754
if ((context_.intrinsics().IsIntrinsic(intrin.name) &&
badIntrinsicsForComponents_.find(intrin.name) !=
- badIntrinsicsForComponents_.end()) ||
- IsProhibitedFunction(intrin.name)) {
+ badIntrinsicsForComponents_.end())) {
return "reference to intrinsic '"s + intrin.name +
"' not allowed for derived type components or type parameter"
" values";
}
- if (context_.intrinsics().GetIntrinsicClass(intrin.name) ==
- IntrinsicClass::inquiryFunction &&
- !IsConstantExpr(x)) {
+ if (inInquiry && !IsConstantExpr(x)) {
return "non-constant reference to inquiry intrinsic '"s +
intrin.name +
"' not allowed for derived type components or type"
" parameter values";
}
- } else if (intrin.name == "present") {
- return std::nullopt; // no need to check argument(s)
+ }
+ if (intrin.name == "present") {
+ // don't bother looking at argument
+ return std::nullopt;
}
if (IsConstantExpr(x)) {
// inquiry functions may not need to check argument(s)
return std::nullopt;
}
}
+ auto restorer{common::ScopedSet(inInquiry_, inInquiry)};
return (*this)(x.arguments());
}
private:
const semantics::Scope &scope_;
FoldingContext &context_;
+ // Contextual information: this flag is true when in an argument to
+ // an inquiry intrinsic like SIZE().
+ mutable bool inInquiry_{false};
const std::set<std::string> badIntrinsicsForComponents_{
"allocated", "associated", "extends_type_of", "present", "same_type_as"};
- static bool IsProhibitedFunction(std::string name) { return false; }
};
template <typename A>
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index c6617f797356..c65825abb1aa 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -1016,7 +1016,7 @@ static const SpecificIntrinsicInterface specificIntrinsicFunction[]{
TypePattern{IntType, KindCode::exactKind, 8}},
"abs"},
{{"len", {{"string", DefaultChar, Rank::anyOrAssumedRank}}, DefaultInt,
- Rank::scalar}},
+ Rank::scalar, IntrinsicClass::inquiryFunction}},
{{"lge", {{"string_a", DefaultChar}, {"string_b", DefaultChar}},
DefaultLogical},
"lge", true},
diff --git a/flang/test/Semantics/spec-expr.f90 b/flang/test/Semantics/spec-expr.f90
index 41e82d708bb8..aa010ed0bf7e 100644
--- a/flang/test/Semantics/spec-expr.f90
+++ b/flang/test/Semantics/spec-expr.f90
@@ -97,13 +97,20 @@ end subroutine s7bii
! (b) a variable that is not an optional dummy argument, and whose
! properties inquired about are not
! (iii) defined by an expression that is not a restricted expression,
-subroutine s7biii()
+subroutine s7biii(x, y)
+ real, intent(out) :: x(:)
+ real, optional :: y(:)
integer, parameter :: localConst = 5
integer :: local = 5
! OK, since "localConst" is a constant
real, dimension(localConst) :: realArray1
!ERROR: Invalid specification expression: reference to local entity 'local'
real, dimension(local) :: realArray2
+ real, dimension(size(realArray1)) :: realArray3 ! ok
+ real, dimension(size(x)) :: realArray4 ! ok
+ real, dimension(merge(1,2,present(y))) :: realArray5 ! ok
+ !ERROR: Invalid specification expression: reference to OPTIONAL dummy argument 'y'
+ real, dimension(size(y)) :: realArray6
end subroutine s7biii
! a specification inquiry that is a constant expression,
diff --git a/flang/test/Semantics/symbol13.f90 b/flang/test/Semantics/symbol13.f90
index 9a3395e61f01..bb087f9a7f32 100644
--- a/flang/test/Semantics/symbol13.f90
+++ b/flang/test/Semantics/symbol13.f90
@@ -10,7 +10,7 @@
!REF: /f1/n
!REF: /f1/x1
!REF: /f1/x2
- !DEF: /f1/len ELEMENTAL, INTRINSIC, PURE (Function) ProcEntity
+ !DEF: /f1/len INTRINSIC, PURE (Function) ProcEntity
character*(n), intent(in) :: x1, x2*(len(x1)+1)
!DEF: /f1/t DerivedType
type :: t
More information about the flang-commits
mailing list