[flang-commits] [flang] 05e62db - [flang] Catch bad inquiries in specification expressions
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Wed Feb 1 12:49:31 PST 2023
Author: Peter Klausler
Date: 2023-02-01T12:49:20-08:00
New Revision: 05e62db29337fe17cf7983ceb999761bcb52148a
URL: https://github.com/llvm/llvm-project/commit/05e62db29337fe17cf7983ceb999761bcb52148a
DIFF: https://github.com/llvm/llvm-project/commit/05e62db29337fe17cf7983ceb999761bcb52148a.diff
LOG: [flang] Catch bad inquiries in specification expressions
When a descriptor inquiry or inquiry function's result is
not constant and is known to be impossible to correctly determine
at runtime, raise an error. For example, LEN(X) when X is
a local allocatable variable with deferred length.
Differential Revision: https://reviews.llvm.org/D142759
Added:
Modified:
flang/include/flang/Semantics/tools.h
flang/lib/Evaluate/check-expression.cpp
flang/lib/Semantics/check-declarations.cpp
flang/lib/Semantics/compute-offsets.cpp
flang/lib/Semantics/resolve-names.cpp
flang/lib/Semantics/tools.cpp
flang/test/Evaluate/errors01.f90
flang/test/Semantics/resolve89.f90
Removed:
################################################################################
diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h
index f72373f9da5e..4c3630c67ebd 100644
--- a/flang/include/flang/Semantics/tools.h
+++ b/flang/include/flang/Semantics/tools.h
@@ -123,7 +123,6 @@ bool IsDestructible(const Symbol &, const Symbol *derivedType = nullptr);
bool HasIntrinsicTypeName(const Symbol &);
bool IsSeparateModuleProcedureInterface(const Symbol *);
bool HasAlternateReturns(const Symbol &);
-bool InCommonBlock(const Symbol &);
// Return an ultimate component of type that matches predicate, or nullptr.
const Symbol *FindUltimateComponent(const DerivedTypeSpec &type,
diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp
index f0d79c90dd33..f0e2bc8f4f5e 100644
--- a/flang/lib/Evaluate/check-expression.cpp
+++ b/flang/lib/Evaluate/check-expression.cpp
@@ -477,6 +477,42 @@ std::optional<Expr<SomeType>> NonPointerInitializationExpr(const Symbol &symbol,
return std::nullopt;
}
+static bool IsNonLocal(const semantics::Symbol &symbol) {
+ return semantics::IsDummy(symbol) || symbol.has<semantics::UseDetails>() ||
+ symbol.owner().kind() == semantics::Scope::Kind::Module ||
+ semantics::FindCommonBlockContaining(symbol) ||
+ symbol.has<semantics::HostAssocDetails>();
+}
+
+static bool IsPermissibleInquiry(const semantics::Symbol &firstSymbol,
+ const semantics::Symbol &lastSymbol, DescriptorInquiry::Field field,
+ const semantics::Scope &localScope) {
+ if (IsNonLocal(firstSymbol)) {
+ return true;
+ }
+ if (&localScope != &firstSymbol.owner()) {
+ return true;
+ }
+ // Inquiries on local objects may not access a deferred bound or length.
+ const auto *object{lastSymbol.detailsIf<semantics::ObjectEntityDetails>()};
+ switch (field) {
+ case DescriptorInquiry::Field::LowerBound:
+ case DescriptorInquiry::Field::Extent:
+ case DescriptorInquiry::Field::Stride:
+ return object && !object->shape().CanBeDeferredShape();
+ case DescriptorInquiry::Field::Rank:
+ return true; // always known
+ case DescriptorInquiry::Field::Len:
+ return object && object->type() &&
+ object->type()->category() == semantics::DeclTypeSpec::Character &&
+ !object->type()->characterTypeSpec().length().isDeferred();
+ default:
+ break;
+ }
+ // TODO: Handle non-deferred LEN type parameters of PDTs
+ return false;
+}
+
// Specification expression validation (10.1.11(2), C1010)
class CheckSpecificationExprHelper
: public AnyTraverse<CheckSpecificationExprHelper,
@@ -561,8 +597,16 @@ class CheckSpecificationExprHelper
// Many uses of SIZE(), LBOUND(), &c. that are valid in specification
// expressions will have been converted to expressions over descriptor
// inquiries by Fold().
- auto restorer{common::ScopedSet(inInquiry_, true)};
- return (*this)(x.base());
+ // Catch REAL, ALLOCATABLE :: X(:); REAL :: Y(SIZE(X))
+ if (IsPermissibleInquiry(x.base().GetFirstSymbol(),
+ x.base().GetLastSymbol(), x.field(), scope_)) {
+ auto restorer{common::ScopedSet(inInquiry_, true)};
+ return (*this)(x.base());
+ } else if (IsConstantExpr(x)) {
+ return std::nullopt;
+ } else {
+ return "non-constant descriptor inquiry not allowed for local object";
+ }
}
Result operator()(const TypeParamInquiry &inq) const {
@@ -606,7 +650,7 @@ class CheckSpecificationExprHelper
}
// References to internal functions are caught in expression semantics.
// TODO: other checks for standard module procedures
- } else {
+ } else { // intrinsic
const SpecificIntrinsic &intrin{DEREF(x.proc().GetSpecificIntrinsic())};
inInquiry = context_.intrinsics().GetIntrinsicClass(intrin.name) ==
IntrinsicClass::inquiryFunction;
@@ -625,14 +669,45 @@ class CheckSpecificationExprHelper
" parameter values";
}
}
- if (intrin.name == "present") {
- // don't bother looking at argument
- return std::nullopt;
- }
+ // Type-determined inquiries (DIGITS, HUGE, &c.) will have already been
+ // folded and won't arrive here. Inquiries that are represented with
+ // DescriptorInquiry operations (LBOUND) are checked elsewhere. If a
+ // call that makes it to here satisfies the requirements of a constant
+ // expression (as Fortran defines it), it's fine.
if (IsConstantExpr(x)) {
- // inquiry functions may not need to check argument(s)
return std::nullopt;
}
+ if (intrin.name == "present") {
+ return std::nullopt; // always ok
+ }
+ // Catch CHARACTER(:), ALLOCATABLE :: X; CHARACTER(LEN(X)) :: Y
+ if (inInquiry && x.arguments().size() >= 1) {
+ if (const auto &arg{x.arguments().at(0)}) {
+ if (auto dataRef{ExtractDataRef(*arg, true, true)}) {
+ if (intrin.name == "allocated" || intrin.name == "associated" ||
+ intrin.name == "is_contiguous") { // ok
+ } else if (intrin.name == "len" &&
+ IsPermissibleInquiry(dataRef->GetFirstSymbol(),
+ dataRef->GetLastSymbol(), DescriptorInquiry::Field::Len,
+ scope_)) { // ok
+ } else if (intrin.name == "lbound" &&
+ IsPermissibleInquiry(dataRef->GetFirstSymbol(),
+ dataRef->GetLastSymbol(),
+ DescriptorInquiry::Field::LowerBound, scope_)) { // ok
+ } else if ((intrin.name == "shape" || intrin.name == "size" ||
+ intrin.name == "sizeof" ||
+ intrin.name == "storage_size" ||
+ intrin.name == "ubound") &&
+ IsPermissibleInquiry(dataRef->GetFirstSymbol(),
+ dataRef->GetLastSymbol(), DescriptorInquiry::Field::Extent,
+ scope_)) { // ok
+ } else {
+ return "non-constant inquiry function '"s + intrin.name +
+ "' not allowed for local object";
+ }
+ }
+ }
+ }
}
auto restorer{common::ScopedSet(inInquiry_, inInquiry)};
return (*this)(x.arguments());
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 7f85f83c79f4..c320c2399c16 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -265,7 +265,7 @@ void CheckHelper::Check(const Symbol &symbol) {
messages_.Say(
"A PROTECTED entity must be a variable or pointer"_err_en_US);
}
- if (InCommonBlock(symbol)) { // C856
+ if (FindCommonBlockContaining(symbol)) { // C856
messages_.Say(
"A PROTECTED entity may not be in a common block"_err_en_US);
}
diff --git a/flang/lib/Semantics/compute-offsets.cpp b/flang/lib/Semantics/compute-offsets.cpp
index 779afa6f0bc3..8789f212feac 100644
--- a/flang/lib/Semantics/compute-offsets.cpp
+++ b/flang/lib/Semantics/compute-offsets.cpp
@@ -101,7 +101,7 @@ void ComputeOffsetsHelper::Compute(Scope &scope) {
}
// Assign offsets for non-COMMON EQUIVALENCE blocks
for (auto &[symbol, blockInfo] : equivalenceBlock_) {
- if (!InCommonBlock(*symbol)) {
+ if (!FindCommonBlockContaining(*symbol)) {
DoSymbol(*symbol);
DoEquivalenceBlockBase(*symbol, blockInfo);
offset_ = std::max(offset_, symbol->offset() + blockInfo.size);
@@ -110,7 +110,7 @@ void ComputeOffsetsHelper::Compute(Scope &scope) {
// Process remaining non-COMMON symbols; this is all of them if there
// was no use of EQUIVALENCE in the scope.
for (auto &symbol : scope.GetSymbols()) {
- if (!InCommonBlock(*symbol) &&
+ if (!FindCommonBlockContaining(*symbol) &&
dependents_.find(symbol) == dependents_.end() &&
equivalenceBlock_.find(symbol) == equivalenceBlock_.end()) {
DoSymbol(*symbol);
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 476554bf5f7f..4c10135b2f8e 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -1146,7 +1146,7 @@ class DeclarationVisitor : public ArraySpecVisitor,
name, symbol, "'%s' is already declared as a procedure"_err_en_US);
} else if (std::is_same_v<ProcEntityDetails, T> &&
symbol.has<ObjectEntityDetails>()) {
- if (InCommonBlock(symbol)) {
+ if (FindCommonBlockContaining(symbol)) {
SayWithDecl(name, symbol,
"'%s' may not be a procedure as it is in a COMMON block"_err_en_US);
} else {
diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp
index a7c56c7a2aa1..562692ee6981 100644
--- a/flang/lib/Semantics/tools.cpp
+++ b/flang/lib/Semantics/tools.cpp
@@ -1418,11 +1418,6 @@ bool HasAlternateReturns(const Symbol &subprogram) {
return false;
}
-bool InCommonBlock(const Symbol &symbol) {
- const auto *details{symbol.detailsIf<ObjectEntityDetails>()};
- return details && details->commonBlock();
-}
-
const std::optional<parser::Name> &MaybeGetNodeName(
const ConstructNode &construct) {
return common::visit(
diff --git a/flang/test/Evaluate/errors01.f90 b/flang/test/Evaluate/errors01.f90
index 72ad988fc204..14702ccf827c 100644
--- a/flang/test/Evaluate/errors01.f90
+++ b/flang/test/Evaluate/errors01.f90
@@ -129,6 +129,14 @@ subroutine s10
!CHECK: warning: ACHAR(I=4294967296) is out of range for CHARACTER(KIND=4)
character(kind=4), parameter :: bada42 = achar(4294967296_8,kind=4)
end subroutine
+ subroutine s11
+ character(:), allocatable :: x1
+ !CHECK: error: Invalid specification expression: non-constant inquiry function 'len' not allowed for local object
+ character(len(x1)) :: x2
+ real, allocatable :: x3(:)
+ !CHECK: error: Invalid specification expression: non-constant descriptor inquiry not allowed for local object
+ real :: x4(size(x3))
+ end
subroutine s12(x,y)
class(t), intent(in) :: x
class(*), intent(in) :: y
diff --git a/flang/test/Semantics/resolve89.f90 b/flang/test/Semantics/resolve89.f90
index e929536b8b36..6b1e77babb98 100644
--- a/flang/test/Semantics/resolve89.f90
+++ b/flang/test/Semantics/resolve89.f90
@@ -54,7 +54,6 @@ subroutine s(iArg, allocArg, pointerArg, arrayArg, ioArg, optionalArg)
! This is OK
real, dimension(merge(1, 2, allocated(mVar))) :: rVar
-
integer :: var = 3
!ERROR: Invalid specification expression: reference to impure function 'ivolatilestmtfunc'
real, dimension(iVolatileStmtFunc()) :: arrayVarWithVolatile
More information about the flang-commits
mailing list