forked from OSchip/llvm-project
508 lines
18 KiB
C++
508 lines
18 KiB
C++
//===-- lib/Evaluate/check-expression.cpp ---------------------------------===//
|
|
//
|
|
// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
|
|
// See https://llvm.org/LICENSE.txt for license information.
|
|
// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
|
|
//
|
|
//===----------------------------------------------------------------------===//
|
|
|
|
#include "flang/Evaluate/check-expression.h"
|
|
#include "flang/Evaluate/intrinsics.h"
|
|
#include "flang/Evaluate/traverse.h"
|
|
#include "flang/Evaluate/type.h"
|
|
#include "flang/Semantics/symbol.h"
|
|
#include "flang/Semantics/tools.h"
|
|
#include <set>
|
|
#include <string>
|
|
|
|
namespace Fortran::evaluate {
|
|
|
|
// Constant expression predicate IsConstantExpr().
|
|
// This code determines whether an expression is a "constant expression"
|
|
// in the sense of section 10.1.12. This is not the same thing as being
|
|
// able to fold it (yet) into a known constant value; specifically,
|
|
// the expression may reference derived type kind parameters whose values
|
|
// are not yet known.
|
|
class IsConstantExprHelper : public AllTraverse<IsConstantExprHelper, true> {
|
|
public:
|
|
using Base = AllTraverse<IsConstantExprHelper, true>;
|
|
IsConstantExprHelper() : Base{*this} {}
|
|
using Base::operator();
|
|
|
|
template <int KIND> bool operator()(const TypeParamInquiry<KIND> &inq) const {
|
|
return IsKindTypeParameter(inq.parameter());
|
|
}
|
|
bool operator()(const semantics::Symbol &symbol) const {
|
|
const auto &ultimate{symbol.GetUltimate()};
|
|
return IsNamedConstant(ultimate) || IsImpliedDoIndex(ultimate) ||
|
|
IsInitialProcedureTarget(ultimate);
|
|
}
|
|
bool operator()(const CoarrayRef &) const { return false; }
|
|
bool operator()(const semantics::ParamValue ¶m) const {
|
|
return param.isExplicit() && (*this)(param.GetExplicit());
|
|
}
|
|
template <typename T> bool operator()(const FunctionRef<T> &call) const {
|
|
if (const auto *intrinsic{std::get_if<SpecificIntrinsic>(&call.proc().u)}) {
|
|
// kind is always a constant, and we avoid cascading errors by calling
|
|
// invalid calls to intrinsics constant
|
|
return intrinsic->name == "kind" ||
|
|
intrinsic->name == IntrinsicProcTable::InvalidName;
|
|
// TODO: other inquiry intrinsics
|
|
} else {
|
|
return false;
|
|
}
|
|
}
|
|
bool operator()(const StructureConstructor &constructor) const {
|
|
for (const auto &[symRef, expr] : constructor) {
|
|
if (!IsConstantStructureConstructorComponent(*symRef, expr.value())) {
|
|
return false;
|
|
}
|
|
}
|
|
return true;
|
|
}
|
|
bool operator()(const Component &component) const {
|
|
return (*this)(component.base());
|
|
}
|
|
// Forbid integer division by zero in constants.
|
|
template <int KIND>
|
|
bool operator()(
|
|
const Divide<Type<TypeCategory::Integer, KIND>> &division) const {
|
|
using T = Type<TypeCategory::Integer, KIND>;
|
|
if (const auto divisor{GetScalarConstantValue<T>(division.right())}) {
|
|
return !divisor->IsZero() && (*this)(division.left());
|
|
} else {
|
|
return false;
|
|
}
|
|
}
|
|
|
|
bool operator()(const Constant<SomeDerived> &) const { return true; }
|
|
|
|
private:
|
|
bool IsConstantStructureConstructorComponent(
|
|
const Symbol &component, const Expr<SomeType> &expr) const {
|
|
if (IsAllocatable(component)) {
|
|
return IsNullPointer(expr);
|
|
} else if (IsPointer(component)) {
|
|
return IsNullPointer(expr) || IsInitialDataTarget(expr) ||
|
|
IsInitialProcedureTarget(expr);
|
|
} else {
|
|
return (*this)(expr);
|
|
}
|
|
}
|
|
};
|
|
|
|
template <typename A> bool IsConstantExpr(const A &x) {
|
|
return IsConstantExprHelper{}(x);
|
|
}
|
|
template bool IsConstantExpr(const Expr<SomeType> &);
|
|
template bool IsConstantExpr(const Expr<SomeInteger> &);
|
|
template bool IsConstantExpr(const Expr<SubscriptInteger> &);
|
|
template bool IsConstantExpr(const StructureConstructor &);
|
|
|
|
// Object pointer initialization checking predicate IsInitialDataTarget().
|
|
// This code determines whether an expression is allowable as the static
|
|
// data address used to initialize a pointer with "=> x". See C765.
|
|
class IsInitialDataTargetHelper
|
|
: public AllTraverse<IsInitialDataTargetHelper, true> {
|
|
public:
|
|
using Base = AllTraverse<IsInitialDataTargetHelper, true>;
|
|
using Base::operator();
|
|
explicit IsInitialDataTargetHelper(parser::ContextualMessages *m)
|
|
: Base{*this}, messages_{m} {}
|
|
|
|
bool emittedMessage() const { return emittedMessage_; }
|
|
|
|
bool operator()(const BOZLiteralConstant &) const { return false; }
|
|
bool operator()(const NullPointer &) const { return true; }
|
|
template <typename T> bool operator()(const Constant<T> &) const {
|
|
return false;
|
|
}
|
|
bool operator()(const semantics::Symbol &symbol) {
|
|
const Symbol &ultimate{symbol.GetUltimate()};
|
|
if (IsAllocatable(ultimate)) {
|
|
if (messages_) {
|
|
messages_->Say(
|
|
"An initial data target may not be a reference to an ALLOCATABLE '%s'"_err_en_US,
|
|
ultimate.name());
|
|
emittedMessage_ = true;
|
|
}
|
|
return false;
|
|
} else if (ultimate.Corank() > 0) {
|
|
if (messages_) {
|
|
messages_->Say(
|
|
"An initial data target may not be a reference to a coarray '%s'"_err_en_US,
|
|
ultimate.name());
|
|
emittedMessage_ = true;
|
|
}
|
|
return false;
|
|
} else if (!ultimate.attrs().test(semantics::Attr::TARGET)) {
|
|
if (messages_) {
|
|
messages_->Say(
|
|
"An initial data target may not be a reference to an object '%s' that lacks the TARGET attribute"_err_en_US,
|
|
ultimate.name());
|
|
emittedMessage_ = true;
|
|
}
|
|
return false;
|
|
} else if (!IsSaved(ultimate)) {
|
|
if (messages_) {
|
|
messages_->Say(
|
|
"An initial data target may not be a reference to an object '%s' that lacks the SAVE attribute"_err_en_US,
|
|
ultimate.name());
|
|
emittedMessage_ = true;
|
|
}
|
|
return false;
|
|
}
|
|
return true;
|
|
}
|
|
bool operator()(const StaticDataObject &) const { return false; }
|
|
template <int KIND> bool operator()(const TypeParamInquiry<KIND> &) const {
|
|
return false;
|
|
}
|
|
bool operator()(const Triplet &x) const {
|
|
return IsConstantExpr(x.lower()) && IsConstantExpr(x.upper()) &&
|
|
IsConstantExpr(x.stride());
|
|
}
|
|
bool operator()(const Subscript &x) const {
|
|
return std::visit(common::visitors{
|
|
[&](const Triplet &t) { return (*this)(t); },
|
|
[&](const auto &y) {
|
|
return y.value().Rank() == 0 &&
|
|
IsConstantExpr(y.value());
|
|
},
|
|
},
|
|
x.u);
|
|
}
|
|
bool operator()(const CoarrayRef &) const { return false; }
|
|
bool operator()(const Substring &x) const {
|
|
return IsConstantExpr(x.lower()) && IsConstantExpr(x.upper()) &&
|
|
(*this)(x.parent());
|
|
}
|
|
bool operator()(const DescriptorInquiry &) const { return false; }
|
|
template <typename T> bool operator()(const ArrayConstructor<T> &) const {
|
|
return false;
|
|
}
|
|
bool operator()(const StructureConstructor &) const { return false; }
|
|
template <typename T> bool operator()(const FunctionRef<T> &) {
|
|
return false;
|
|
}
|
|
template <typename D, typename R, typename... O>
|
|
bool operator()(const Operation<D, R, O...> &) const {
|
|
return false;
|
|
}
|
|
template <typename T> bool operator()(const Parentheses<T> &x) const {
|
|
return (*this)(x.left());
|
|
}
|
|
bool operator()(const Relational<SomeType> &) const { return false; }
|
|
|
|
private:
|
|
parser::ContextualMessages *messages_;
|
|
bool emittedMessage_{false};
|
|
};
|
|
|
|
bool IsInitialDataTarget(
|
|
const Expr<SomeType> &x, parser::ContextualMessages *messages) {
|
|
IsInitialDataTargetHelper helper{messages};
|
|
bool result{helper(x)};
|
|
if (!result && messages && !helper.emittedMessage()) {
|
|
messages->Say(
|
|
"An initial data target must be a designator with constant subscripts"_err_en_US);
|
|
}
|
|
return result;
|
|
}
|
|
|
|
bool IsInitialProcedureTarget(const semantics::Symbol &symbol) {
|
|
const auto &ultimate{symbol.GetUltimate()};
|
|
return std::visit(
|
|
common::visitors{
|
|
[](const semantics::SubprogramDetails &) { return true; },
|
|
[](const semantics::SubprogramNameDetails &) { return true; },
|
|
[&](const semantics::ProcEntityDetails &proc) {
|
|
return !semantics::IsPointer(ultimate) && !proc.isDummy();
|
|
},
|
|
[](const auto &) { return false; },
|
|
},
|
|
ultimate.details());
|
|
}
|
|
|
|
bool IsInitialProcedureTarget(const ProcedureDesignator &proc) {
|
|
if (const auto *intrin{proc.GetSpecificIntrinsic()}) {
|
|
return !intrin->isRestrictedSpecific;
|
|
} else if (proc.GetComponent()) {
|
|
return false;
|
|
} else {
|
|
return IsInitialProcedureTarget(DEREF(proc.GetSymbol()));
|
|
}
|
|
}
|
|
|
|
bool IsInitialProcedureTarget(const Expr<SomeType> &expr) {
|
|
if (const auto *proc{std::get_if<ProcedureDesignator>(&expr.u)}) {
|
|
return IsInitialProcedureTarget(*proc);
|
|
} else {
|
|
return IsNullPointer(expr);
|
|
}
|
|
}
|
|
|
|
// Specification expression validation (10.1.11(2), C1010)
|
|
class CheckSpecificationExprHelper
|
|
: public AnyTraverse<CheckSpecificationExprHelper,
|
|
std::optional<std::string>> {
|
|
public:
|
|
using Result = std::optional<std::string>;
|
|
using Base = AnyTraverse<CheckSpecificationExprHelper, Result>;
|
|
explicit CheckSpecificationExprHelper(
|
|
const semantics::Scope &s, const IntrinsicProcTable &table)
|
|
: Base{*this}, scope_{s}, table_{table} {}
|
|
using Base::operator();
|
|
|
|
Result operator()(const ProcedureDesignator &) const {
|
|
return "dummy procedure argument";
|
|
}
|
|
Result operator()(const CoarrayRef &) const { return "coindexed reference"; }
|
|
|
|
Result operator()(const semantics::Symbol &symbol) const {
|
|
if (semantics::IsNamedConstant(symbol)) {
|
|
return std::nullopt;
|
|
} else if (scope_.IsDerivedType() && IsVariableName(symbol)) { // C750, C754
|
|
return "derived type component or type parameter value not allowed to "
|
|
"reference variable '"s +
|
|
symbol.name().ToString() + "'";
|
|
} else if (IsDummy(symbol)) {
|
|
if (symbol.attrs().test(semantics::Attr::OPTIONAL)) {
|
|
return "reference to OPTIONAL dummy argument '"s +
|
|
symbol.name().ToString() + "'";
|
|
} else if (symbol.attrs().test(semantics::Attr::INTENT_OUT)) {
|
|
return "reference to INTENT(OUT) dummy argument '"s +
|
|
symbol.name().ToString() + "'";
|
|
} else if (symbol.has<semantics::ObjectEntityDetails>()) {
|
|
return std::nullopt;
|
|
} else {
|
|
return "dummy procedure argument";
|
|
}
|
|
} else if (symbol.has<semantics::UseDetails>() ||
|
|
symbol.has<semantics::HostAssocDetails>() ||
|
|
symbol.owner().kind() == semantics::Scope::Kind::Module) {
|
|
return std::nullopt;
|
|
} else if (const auto *object{
|
|
symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
|
|
// TODO: what about EQUIVALENCE with data in COMMON?
|
|
// TODO: does this work for blank COMMON?
|
|
if (object->commonBlock()) {
|
|
return std::nullopt;
|
|
}
|
|
}
|
|
for (const semantics::Scope *s{&scope_}; !s->IsGlobal();) {
|
|
s = &s->parent();
|
|
if (s == &symbol.owner()) {
|
|
return std::nullopt;
|
|
}
|
|
}
|
|
return "reference to local entity '"s + symbol.name().ToString() + "'";
|
|
}
|
|
|
|
Result operator()(const Component &x) const {
|
|
// 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
|
|
// expressions will have been converted to expressions over descriptor
|
|
// inquiries by Fold().
|
|
return std::nullopt;
|
|
}
|
|
|
|
template <int KIND>
|
|
Result operator()(const TypeParamInquiry<KIND> &inq) const {
|
|
if (scope_.IsDerivedType() && !IsConstantExpr(inq) &&
|
|
inq.parameter().owner() != scope_) { // C750, C754
|
|
return "non-constant reference to a type parameter inquiry not "
|
|
"allowed for derived type components or type parameter values";
|
|
}
|
|
return std::nullopt;
|
|
}
|
|
|
|
template <typename T> Result operator()(const FunctionRef<T> &x) const {
|
|
if (const auto *symbol{x.proc().GetSymbol()}) {
|
|
if (!semantics::IsPureProcedure(*symbol)) {
|
|
return "reference to impure function '"s + symbol->name().ToString() +
|
|
"'";
|
|
}
|
|
if (semantics::IsStmtFunction(*symbol)) {
|
|
return "reference to statement function '"s +
|
|
symbol->name().ToString() + "'";
|
|
}
|
|
if (scope_.IsDerivedType()) { // C750, C754
|
|
return "reference to function '"s + symbol->name().ToString() +
|
|
"' not allowed for derived type components or type parameter"
|
|
" values";
|
|
}
|
|
// TODO: other checks for standard module procedures
|
|
} else {
|
|
const SpecificIntrinsic &intrin{DEREF(x.proc().GetSpecificIntrinsic())};
|
|
if (scope_.IsDerivedType()) { // C750, C754
|
|
if ((table_.IsIntrinsic(intrin.name) &&
|
|
badIntrinsicsForComponents_.find(intrin.name) !=
|
|
badIntrinsicsForComponents_.end()) ||
|
|
IsProhibitedFunction(intrin.name)) {
|
|
return "reference to intrinsic '"s + intrin.name +
|
|
"' not allowed for derived type components or type parameter"
|
|
" values";
|
|
}
|
|
if (table_.GetIntrinsicClass(intrin.name) ==
|
|
IntrinsicClass::inquiryFunction &&
|
|
!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 (IsConstantExpr(x)) {
|
|
// inquiry functions may not need to check argument(s)
|
|
return std::nullopt;
|
|
}
|
|
}
|
|
return (*this)(x.arguments());
|
|
}
|
|
|
|
private:
|
|
const semantics::Scope &scope_;
|
|
const IntrinsicProcTable &table_;
|
|
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>
|
|
void CheckSpecificationExpr(const A &x, parser::ContextualMessages &messages,
|
|
const semantics::Scope &scope, const IntrinsicProcTable &table) {
|
|
if (auto why{CheckSpecificationExprHelper{scope, table}(x)}) {
|
|
messages.Say("Invalid specification expression: %s"_err_en_US, *why);
|
|
}
|
|
}
|
|
|
|
template void CheckSpecificationExpr(const Expr<SomeType> &,
|
|
parser::ContextualMessages &, const semantics::Scope &,
|
|
const IntrinsicProcTable &);
|
|
template void CheckSpecificationExpr(const Expr<SomeInteger> &,
|
|
parser::ContextualMessages &, const semantics::Scope &,
|
|
const IntrinsicProcTable &);
|
|
template void CheckSpecificationExpr(const Expr<SubscriptInteger> &,
|
|
parser::ContextualMessages &, const semantics::Scope &,
|
|
const IntrinsicProcTable &);
|
|
template void CheckSpecificationExpr(const std::optional<Expr<SomeType>> &,
|
|
parser::ContextualMessages &, const semantics::Scope &,
|
|
const IntrinsicProcTable &);
|
|
template void CheckSpecificationExpr(const std::optional<Expr<SomeInteger>> &,
|
|
parser::ContextualMessages &, const semantics::Scope &,
|
|
const IntrinsicProcTable &);
|
|
template void CheckSpecificationExpr(
|
|
const std::optional<Expr<SubscriptInteger>> &, parser::ContextualMessages &,
|
|
const semantics::Scope &, const IntrinsicProcTable &);
|
|
|
|
// IsSimplyContiguous() -- 9.5.4
|
|
class IsSimplyContiguousHelper
|
|
: public AnyTraverse<IsSimplyContiguousHelper, std::optional<bool>> {
|
|
public:
|
|
using Result = std::optional<bool>; // tri-state
|
|
using Base = AnyTraverse<IsSimplyContiguousHelper, Result>;
|
|
explicit IsSimplyContiguousHelper(const IntrinsicProcTable &t)
|
|
: Base{*this}, table_{t} {}
|
|
using Base::operator();
|
|
|
|
Result operator()(const semantics::Symbol &symbol) const {
|
|
if (symbol.attrs().test(semantics::Attr::CONTIGUOUS) ||
|
|
symbol.Rank() == 0) {
|
|
return true;
|
|
} else if (semantics::IsPointer(symbol)) {
|
|
return false;
|
|
} else if (const auto *details{
|
|
symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
|
|
// N.B. ALLOCATABLEs are deferred shape, not assumed, and
|
|
// are obviously contiguous.
|
|
return !details->IsAssumedShape() && !details->IsAssumedRank();
|
|
} else {
|
|
return false;
|
|
}
|
|
}
|
|
|
|
Result operator()(const ArrayRef &x) const {
|
|
const auto &symbol{x.GetLastSymbol()};
|
|
if (!(*this)(symbol)) {
|
|
return false;
|
|
} else if (auto rank{CheckSubscripts(x.subscript())}) {
|
|
// a(:)%b(1,1) is not contiguous; a(1)%b(:,:) is
|
|
return *rank > 0 || x.Rank() == 0;
|
|
} else {
|
|
return false;
|
|
}
|
|
}
|
|
Result operator()(const CoarrayRef &x) const {
|
|
return CheckSubscripts(x.subscript()).has_value();
|
|
}
|
|
Result operator()(const Component &x) const {
|
|
return x.base().Rank() == 0 && (*this)(x.GetLastSymbol());
|
|
}
|
|
Result operator()(const ComplexPart &) const { return false; }
|
|
Result operator()(const Substring &) const { return false; }
|
|
|
|
template <typename T> Result operator()(const FunctionRef<T> &x) const {
|
|
if (auto chars{
|
|
characteristics::Procedure::Characterize(x.proc(), table_)}) {
|
|
if (chars->functionResult) {
|
|
const auto &result{*chars->functionResult};
|
|
return !result.IsProcedurePointer() &&
|
|
result.attrs.test(characteristics::FunctionResult::Attr::Pointer) &&
|
|
result.attrs.test(
|
|
characteristics::FunctionResult::Attr::Contiguous);
|
|
}
|
|
}
|
|
return false;
|
|
}
|
|
|
|
private:
|
|
// If the subscripts can possibly be on a simply-contiguous array reference,
|
|
// return the rank.
|
|
static std::optional<int> CheckSubscripts(
|
|
const std::vector<Subscript> &subscript) {
|
|
bool anyTriplet{false};
|
|
int rank{0};
|
|
for (auto j{subscript.size()}; j-- > 0;) {
|
|
if (const auto *triplet{std::get_if<Triplet>(&subscript[j].u)}) {
|
|
if (!triplet->IsStrideOne()) {
|
|
return std::nullopt;
|
|
} else if (anyTriplet) {
|
|
if (triplet->lower() || triplet->upper()) {
|
|
// all triplets before the last one must be just ":"
|
|
return std::nullopt;
|
|
}
|
|
} else {
|
|
anyTriplet = true;
|
|
}
|
|
++rank;
|
|
} else if (anyTriplet || subscript[j].Rank() > 0) {
|
|
return std::nullopt;
|
|
}
|
|
}
|
|
return rank;
|
|
}
|
|
|
|
const IntrinsicProcTable &table_;
|
|
};
|
|
|
|
template <typename A>
|
|
bool IsSimplyContiguous(const A &x, const IntrinsicProcTable &table) {
|
|
if (IsVariable(x)) {
|
|
auto known{IsSimplyContiguousHelper{table}(x)};
|
|
return known && *known;
|
|
} else {
|
|
return true; // not a variable
|
|
}
|
|
}
|
|
|
|
template bool IsSimplyContiguous(
|
|
const Expr<SomeType> &, const IntrinsicProcTable &);
|
|
|
|
} // namespace Fortran::evaluate
|