From 05e62db29337fe17cf7983ceb999761bcb52148a Mon Sep 17 00:00:00 2001 From: Peter Klausler Date: Thu, 5 Jan 2023 14:11:54 -0800 Subject: [PATCH] [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 --- flang/include/flang/Semantics/tools.h | 1 - flang/lib/Evaluate/check-expression.cpp | 91 ++++++++++++++++++++-- flang/lib/Semantics/check-declarations.cpp | 2 +- flang/lib/Semantics/compute-offsets.cpp | 4 +- flang/lib/Semantics/resolve-names.cpp | 2 +- flang/lib/Semantics/tools.cpp | 5 -- flang/test/Evaluate/errors01.f90 | 8 ++ flang/test/Semantics/resolve89.f90 | 1 - 8 files changed, 95 insertions(+), 19 deletions(-) diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h index f72373f9da5e3..4c3630c67ebd2 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 f0d79c90dd33e..f0e2bc8f4f5ef 100644 --- a/flang/lib/Evaluate/check-expression.cpp +++ b/flang/lib/Evaluate/check-expression.cpp @@ -477,6 +477,42 @@ std::optional> NonPointerInitializationExpr(const Symbol &symbol, return std::nullopt; } +static bool IsNonLocal(const semantics::Symbol &symbol) { + return semantics::IsDummy(symbol) || symbol.has() || + symbol.owner().kind() == semantics::Scope::Kind::Module || + semantics::FindCommonBlockContaining(symbol) || + symbol.has(); +} + +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()}; + 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= 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 7f85f83c79f4e..c320c2399c16d 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 779afa6f0bc3d..8789f212feacf 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 476554bf5f7f1..4c10135b2f8ea 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 && symbol.has()) { - 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 a7c56c7a2aa17..562692ee69818 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()}; - return details && details->commonBlock(); -} - const std::optional &MaybeGetNodeName( const ConstructNode &construct) { return common::visit( diff --git a/flang/test/Evaluate/errors01.f90 b/flang/test/Evaluate/errors01.f90 index 72ad988fc2042..14702ccf827c8 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 e929536b8b362..6b1e77babb980 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