[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
This commit is contained in:
Peter Klausler
2023-01-05 14:11:54 -08:00
parent 2c46051aa9
commit 05e62db293
8 changed files with 95 additions and 19 deletions

View File

@@ -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,

View File

@@ -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 @@ public:
// 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 @@ public:
}
// 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,13 +669,44 @@ public:
" parameter values";
}
}
if (intrin.name == "present") {
// don't bother looking at argument
// 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)) {
return std::nullopt;
}
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)};

View File

@@ -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);
}

View File

@@ -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);

View File

@@ -1146,7 +1146,7 @@ private:
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 {

View File

@@ -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(

View File

@@ -129,6 +129,14 @@ module m
!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

View File

@@ -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