// Checks whether an expression is an object designator with
// constant addressing and no vector-valued subscript.
-bool IsInitialDataTarget(const Expr<SomeType> &, parser::ContextualMessages &);
+bool IsInitialDataTarget(
+ const Expr<SomeType> &, parser::ContextualMessages * = nullptr);
// Check whether an expression is a specification expression
// (10.1.11(2), C1010). Constant expressions are always valid
// Procedure pointer targets are treated as if they were typeless.
// They are either procedure designators or values returned from
-// function references.
+// references to functions that return procedure (not object) pointers.
using TypelessExpression = std::variant<BOZLiteralConstant, NullPointer,
ProcedureDesignator, ProcedureRef>;
// Some expression predicates and extractors.
-// When an Expr holds something that is a Variable (i.e., a Designator
-// or pointer-valued FunctionRef), return a copy of its contents in
-// a Variable.
-template <typename A>
-std::optional<Variable<A>> AsVariable(const Expr<A> &expr) {
- using Variant = decltype(Variable<A>::u);
- return std::visit(
- [](const auto &x) -> std::optional<Variable<A>> {
- if constexpr (common::HasMember<std::decay_t<decltype(x)>, Variant>) {
- return Variable<A>{x};
- }
- return std::nullopt;
- },
- expr.u);
-}
-
-template <typename A>
-std::optional<Variable<A>> AsVariable(const std::optional<Expr<A>> &expr) {
- if (expr) {
- return AsVariable(*expr);
- } else {
- return std::nullopt;
- }
-}
-
// Predicate: true when an expression is a variable reference, not an
// operation. Be advised: a call to a function that returns an object
// pointer is a "variable" in Fortran (it can be the left-hand side of
FOR_EACH_CHARACTER_KIND(extern template class Designator, )
-template <typename T> struct Variable {
- using Result = T;
- static_assert(IsSpecificIntrinsicType<Result> ||
- std::is_same_v<Result, SomeKind<TypeCategory::Derived>>);
- EVALUATE_UNION_CLASS_BOILERPLATE(Variable)
- std::optional<DynamicType> GetType() const {
- return std::visit([](const auto &x) { return x.GetType(); }, u);
- }
- int Rank() const {
- return std::visit([](const auto &x) { return x.Rank(); }, u);
- }
- llvm::raw_ostream &AsFortran(llvm::raw_ostream &o) const {
- std::visit([&](const auto &x) { x.AsFortran(o); }, u);
- return o;
- }
- std::variant<Designator<Result>, FunctionRef<Result>> u;
-};
-
class DescriptorInquiry {
public:
using Result = SubscriptInteger;
#include "format-specification.h"
#include "parse-tree-visitor.h"
#include "parse-tree.h"
+#include "tools.h"
#include "unparse.h"
#include "flang/Common/idioms.h"
#include "flang/Common/indirection.h"
namespace Fortran::parser {
-// When SHOW_ALL_SOURCE_MEMBERS is defined, HasSource<T>::value is true if T has
-// a member named source
-template <typename T, typename = int> struct HasSource : std::false_type {};
-#ifdef SHOW_ALL_SOURCE_MEMBERS
-template <typename T>
-struct HasSource<T, decltype((void)T::source, 0)> : std::true_type {};
-#endif
-
//
// Dump the Parse Tree hierarchy of any node 'x' of the parse tree.
//
if (ss.tell()) {
return ss.str();
}
- if constexpr (std::is_same_v<T, Name> || HasSource<T>::value) {
+ if constexpr (std::is_same_v<T, Name>) {
return x.source.ToString();
+#ifdef SHOW_ALL_SOURCE_MEMBERS
+ } else if constexpr (HasSource<T>::value) {
+ return x.source.ToString();
+#endif
} else if constexpr (std::is_same_v<T, std::string>) {
return x;
} else {
};
template <typename T>
-void DumpTree(llvm::raw_ostream &out, const T &x,
+llvm::raw_ostream &DumpTree(llvm::raw_ostream &out, const T &x,
const AnalyzedObjectsAsFortran *asFortran = nullptr) {
ParseTreeDumper dumper{out, asFortran};
Walk(x, dumper);
+ return out;
}
} // namespace Fortran::parser
// R846 int-constant-subobject -> constant-subobject
using ConstantSubobject = Constant<common::Indirection<Designator>>;
+// Represents an analyzed expression
+using TypedExpr = std::unique_ptr<evaluate::GenericExprWrapper,
+ common::Deleter<evaluate::GenericExprWrapper>>;
+
// R845 data-stmt-constant ->
// scalar-constant | scalar-constant-subobject |
// signed-int-literal-constant | signed-real-literal-constant |
// null-init | initial-data-target | structure-constructor
struct DataStmtConstant {
UNION_CLASS_BOILERPLATE(DataStmtConstant);
+ CharBlock source;
+ mutable TypedExpr typedExpr;
std::variant<Scalar<ConstantValue>, Scalar<ConstantSubobject>,
SignedIntLiteralConstant, SignedRealLiteralConstant,
SignedComplexLiteralConstant, NullInit, InitialDataTarget,
explicit Expr(Designator &&);
explicit Expr(FunctionReference &&);
- // Filled in with expression after successful semantic analysis.
- using TypedExpr = std::unique_ptr<evaluate::GenericExprWrapper,
- common::Deleter<evaluate::GenericExprWrapper>>;
mutable TypedExpr typedExpr;
CharBlock source;
// R902 variable -> designator | function-reference
struct Variable {
UNION_CLASS_BOILERPLATE(Variable);
- mutable Expr::TypedExpr typedExpr;
+ mutable TypedExpr typedExpr;
parser::CharBlock GetSource() const;
std::variant<common::Indirection<Designator>,
common::Indirection<FunctionReference>>
const CoindexedNamedObject *GetCoindexedNamedObject(const AllocateObject &);
const CoindexedNamedObject *GetCoindexedNamedObject(const DataRef &);
+// Detects parse tree nodes with "source" members.
+template <typename A, typename = int> struct HasSource : std::false_type {};
+template <typename A>
+struct HasSource<A, decltype(static_cast<void>(A::source), 0)>
+ : std::true_type {};
+
} // namespace Fortran::parser
#endif // FORTRAN_PARSER_TOOLS_H_
#include "flang/Parser/char-block.h"
#include "flang/Parser/parse-tree-visitor.h"
#include "flang/Parser/parse-tree.h"
+#include "flang/Parser/tools.h"
#include <map>
#include <optional>
+#include <type_traits>
#include <variant>
using namespace Fortran::parser::literals;
namespace Fortran::parser {
struct SourceLocationFindingVisitor {
- template <typename A> bool Pre(const A &) { return true; }
- template <typename A> void Post(const A &) {}
- bool Pre(const Expr &x) {
- source = x.source;
- return false;
- }
- bool Pre(const Designator &x) {
- source = x.source;
- return false;
- }
- bool Pre(const Call &x) {
- source = x.source;
- return false;
- }
- bool Pre(const CompilerDirective &x) {
- source = x.source;
- return false;
- }
- bool Pre(const GenericSpec &x) {
- source = x.source;
- return false;
- }
- template <typename A> bool Pre(const UnlabeledStatement<A> &stmt) {
- source = stmt.source;
- return false;
+ template <typename A> bool Pre(const A &x) {
+ if constexpr (HasSource<A>::value) {
+ source.ExtendToCover(x.source);
+ return false;
+ } else {
+ return true;
+ }
}
- void Post(const CharBlock &at) { source = at; }
+ template <typename A> void Post(const A &) {}
+ void Post(const CharBlock &at) { source.ExtendToCover(at); }
CharBlock source;
};
struct SetExprHelper {
explicit SetExprHelper(GenericExprWrapper &&expr) : expr_{std::move(expr)} {}
- void Set(parser::Expr::TypedExpr &x) {
+ void Set(parser::TypedExpr &x) {
x.reset(new GenericExprWrapper{std::move(expr_)});
}
void Set(const parser::Expr &x) { Set(x.typedExpr); }
void Set(const parser::Variable &x) { Set(x.typedExpr); }
+ void Set(const parser::DataStmtConstant &x) { Set(x.typedExpr); }
template <typename T> void Set(const common::Indirection<T> &x) {
Set(x.value());
}
bool CheckIntrinsicKind(TypeCategory, std::int64_t kind);
bool CheckIntrinsicSize(TypeCategory, std::int64_t size);
- // Manage a set of active array constructor implied DO loops.
- bool AddAcImpliedDo(parser::CharBlock, int);
- void RemoveAcImpliedDo(parser::CharBlock);
- std::optional<int> IsAcImpliedDo(parser::CharBlock) const;
+ // Manage a set of active implied DO loops.
+ bool AddImpliedDo(parser::CharBlock, int);
+ void RemoveImpliedDo(parser::CharBlock);
+ std::optional<int> IsImpliedDo(parser::CharBlock) const;
Expr<SubscriptInteger> AnalyzeKindSelector(common::TypeCategory category,
const std::optional<parser::KindSelector> &);
MaybeExpr Analyze(const parser::Expr &);
MaybeExpr Analyze(const parser::Variable &);
MaybeExpr Analyze(const parser::Designator &);
+ MaybeExpr Analyze(const parser::DataStmtConstant &);
template <typename A> MaybeExpr Analyze(const common::Indirection<A> &x) {
return Analyze(x.value());
MaybeExpr Analyze(const parser::SignedRealLiteralConstant &);
MaybeExpr Analyze(const parser::SignedComplexLiteralConstant &);
MaybeExpr Analyze(const parser::StructureConstructor &);
+ MaybeExpr Analyze(const parser::InitialDataTarget &);
void Analyze(const parser::CallStmt &);
const Assignment *Analyze(const parser::AssignmentStmt &);
MaybeExpr Analyze(const parser::HollerithLiteralConstant &);
MaybeExpr Analyze(const parser::BOZLiteralConstant &);
MaybeExpr Analyze(const parser::NamedConstant &);
+ MaybeExpr Analyze(const parser::NullInit &);
MaybeExpr Analyze(const parser::Substring &);
MaybeExpr Analyze(const parser::ArrayElement &);
MaybeExpr Analyze(const parser::CoindexedNamedObject &);
semantics::SemanticsContext &context_;
FoldingContext &foldingContext_{context_.foldingContext()};
- std::map<parser::CharBlock, int> acImpliedDos_; // values are INTEGER kinds
+ std::map<parser::CharBlock, int> impliedDos_; // values are INTEGER kinds
bool fatalErrors_{false};
friend class ArgumentAnalyzer;
};
AnalyzeExpr(context_, x);
return false;
}
+ bool Pre(const parser::DataStmtConstant &x) {
+ AnalyzeExpr(context_, x);
+ return false;
+ }
bool Pre(const parser::CallStmt &x) {
AnalyzeCallStmt(context_, x);
return false;
AnalyzePointerAssignmentStmt(context_, x);
return false;
}
- bool Pre(const parser::DataStmtConstant &);
template <typename A> bool Pre(const parser::Scalar<A> &x) {
AnalyzeExpr(context_, x);
return false;
}
}
+ bool operator()(const StructureConstructor &constructor) const {
+ for (const auto &[symRef, expr] : constructor) {
+ if (IsAllocatable(*symRef)) {
+ return IsNullPointer(expr.value());
+ } else if (IsPointer(*symRef)) {
+ return IsNullPointer(expr.value()) || IsInitialDataTarget(expr.value());
+ } else if (!(*this)(expr.value())) {
+ return false;
+ }
+ }
+ return true;
+ }
// Forbid integer division by zero in constants.
template <int KIND>
// 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.
-struct IsInitialDataTargetHelper
+// If messages are requested, errors may be generated without returning
+// a false result.
+class IsInitialDataTargetHelper
: public AllTraverse<IsInitialDataTargetHelper, true> {
+public:
using Base = AllTraverse<IsInitialDataTargetHelper, true>;
using Base::operator();
- explicit IsInitialDataTargetHelper(parser::ContextualMessages &m)
+ explicit IsInitialDataTargetHelper(parser::ContextualMessages *m)
: Base{*this}, messages_{m} {}
bool operator()(const BOZLiteralConstant &) const { return false; }
bool operator()(const semantics::Symbol &symbol) const {
const Symbol &ultimate{symbol.GetUltimate()};
if (IsAllocatable(ultimate)) {
- messages_.Say(
- "An initial data target may not be a reference to an ALLOCATABLE '%s'"_err_en_US,
- ultimate.name());
+ if (messages_) {
+ messages_->Say(
+ "An initial data target may not be a reference to an ALLOCATABLE '%s'"_err_en_US,
+ ultimate.name());
+ } else {
+ return false;
+ }
} else if (ultimate.Corank() > 0) {
- messages_.Say(
- "An initial data target may not be a reference to a coarray '%s'"_err_en_US,
- ultimate.name());
+ if (messages_) {
+ messages_->Say(
+ "An initial data target may not be a reference to a coarray '%s'"_err_en_US,
+ ultimate.name());
+ } else {
+ return false;
+ }
} else if (!ultimate.attrs().test(semantics::Attr::TARGET)) {
- 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());
+ 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());
+ } else {
+ return false;
+ }
} else if (!IsSaved(ultimate)) {
- 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());
+ 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());
+ } else {
+ return false;
+ }
}
return true;
}
return (*this)(x.left());
}
bool operator()(const Relational<SomeType> &) const { return false; }
-
private:
- parser::ContextualMessages &messages_;
+ parser::ContextualMessages *messages_;
};
bool IsInitialDataTarget(
- const Expr<SomeType> &x, parser::ContextualMessages &messages) {
+ const Expr<SomeType> &x, parser::ContextualMessages *messages) {
return IsInitialDataTargetHelper{messages}(x);
}
bool Designator<T>::operator==(const Designator<T> &that) const {
return TestVariableEquality(*this, that);
}
-template <typename T>
-bool Variable<T>::operator==(const Variable<T> &that) const {
- return u == that.u;
-}
bool DescriptorInquiry::operator==(const DescriptorInquiry &that) const {
return field_ == that.field_ && base_ == that.base_ &&
dimension_ == that.dimension_;
// null-init | initial-data-target | structure-constructor
// TODO: Some structure constructors can be misrecognized as array
// references into constant subobjects.
-TYPE_PARSER(first(construct<DataStmtConstant>(scalar(Parser<ConstantValue>{})),
+TYPE_PARSER(sourced(first(
+ construct<DataStmtConstant>(scalar(Parser<ConstantValue>{})),
construct<DataStmtConstant>(nullInit),
construct<DataStmtConstant>(scalar(constantSubobject)) / !"("_tok,
construct<DataStmtConstant>(Parser<StructureConstructor>{}),
construct<DataStmtConstant>(signedIntLiteralConstant),
extension<LanguageFeature::SignedComplexLiteral>(
construct<DataStmtConstant>(Parser<SignedComplexLiteralConstant>{})),
- construct<DataStmtConstant>(initialDataTarget)))
+ construct<DataStmtConstant>(initialDataTarget))))
// R848 dimension-stmt ->
// DIMENSION [::] array-name ( array-spec )
//===----------------------------------------------------------------------===//
#include "check-data.h"
+#include "flang/Evaluate/traverse.h"
+#include "flang/Semantics/expression.h"
namespace Fortran::semantics {
-template <typename T> void DataChecker::CheckIfConstantSubscript(const T &x) {
- evaluate::ExpressionAnalyzer exprAnalyzer{context_};
- if (MaybeExpr checked{exprAnalyzer.Analyze(x)}) {
- if (!evaluate::IsConstantExpr(*checked)) { // C875,C881
- context_.Say(parser::FindSourceLocation(x),
- "Data object must have constant bounds"_err_en_US);
- }
- }
-}
-
-void DataChecker::CheckSubscript(const parser::SectionSubscript &subscript) {
- std::visit(common::visitors{
- [&](const parser::SubscriptTriplet &triplet) {
- CheckIfConstantSubscript(std::get<0>(triplet.t));
- CheckIfConstantSubscript(std::get<1>(triplet.t));
- CheckIfConstantSubscript(std::get<2>(triplet.t));
- },
- [&](const parser::IntExpr &intExpr) {
- CheckIfConstantSubscript(intExpr);
- },
- },
- subscript.u);
-}
-
-// Returns false if DataRef has no subscript
-bool DataChecker::CheckAllSubscriptsInDataRef(
- const parser::DataRef &dataRef, parser::CharBlock source) {
- return std::visit(
- common::visitors{
- [&](const parser::Name &) { return false; },
- [&](const common::Indirection<parser::StructureComponent>
- &structureComp) {
- return CheckAllSubscriptsInDataRef(
- structureComp.value().base, source);
- },
- [&](const common::Indirection<parser::ArrayElement> &arrayElem) {
- for (auto &subscript : arrayElem.value().subscripts) {
- CheckSubscript(subscript);
- }
- CheckAllSubscriptsInDataRef(arrayElem.value().base, source);
- return true;
- },
- [&](const common::Indirection<parser::CoindexedNamedObject>
- &coindexedObj) { // C874
- context_.Say(source,
- "Data object must not be a coindexed variable"_err_en_US);
- CheckAllSubscriptsInDataRef(coindexedObj.value().base, source);
- return true;
- },
- },
- dataRef.u);
-}
-
void DataChecker::Leave(const parser::DataStmtConstant &dataConst) {
if (auto *structure{
std::get_if<parser::StructureConstructor>(&dataConst.u)}) {
std::get<parser::ComponentDataSource>(component.t).v.value()};
if (const auto *expr{GetExpr(parsedExpr)}) {
if (!evaluate::IsConstantExpr(*expr)) { // C884
- context_.Say(parsedExpr.source,
+ exprAnalyzer_.Say(parsedExpr.source,
"Structure constructor in data value must be a constant expression"_err_en_US);
}
}
}
}
+// Ensures that references to an implied DO loop control variable are
+// represented as such in the "body" of the implied DO loop.
+void DataChecker::Enter(const parser::DataImpliedDo &x) {
+ auto name{std::get<parser::DataImpliedDo::Bounds>(x.t).name.thing.thing};
+ int kind{evaluate::ResultType<evaluate::ImpliedDoIndex>::kind};
+ if (const auto dynamicType{evaluate::DynamicType::From(*name.symbol)}) {
+ kind = dynamicType->kind();
+ }
+ exprAnalyzer_.AddImpliedDo(name.source, kind);
+}
+
+void DataChecker::Leave(const parser::DataImpliedDo &x) {
+ auto name{std::get<parser::DataImpliedDo::Bounds>(x.t).name.thing.thing};
+ exprAnalyzer_.RemoveImpliedDo(name.source);
+}
+
+class DataVarChecker : public evaluate::AllTraverse<DataVarChecker, true> {
+public:
+ using Base = evaluate::AllTraverse<DataVarChecker, true>;
+ DataVarChecker(SemanticsContext &c, parser::CharBlock src)
+ : Base{*this}, context_{c}, source_{src} {}
+ using Base::operator();
+ bool HasComponentWithoutSubscripts() const {
+ return hasComponent_ && !hasSubscript_;
+ }
+ bool operator()(const evaluate::Component &component) {
+ hasComponent_ = true;
+ return (*this)(component.base());
+ }
+ bool operator()(const evaluate::Subscript &subs) {
+ hasSubscript_ = true;
+ return std::visit(
+ common::visitors{
+ [&](const evaluate::IndirectSubscriptIntegerExpr &expr) {
+ return CheckSubscriptExpr(expr);
+ },
+ [&](const evaluate::Triplet &triplet) {
+ return CheckSubscriptExpr(triplet.lower()) &&
+ CheckSubscriptExpr(triplet.upper()) &&
+ CheckSubscriptExpr(triplet.stride());
+ },
+ },
+ subs.u);
+ }
+ template <typename T>
+ bool operator()(const evaluate::FunctionRef<T> &) const { // C875
+ context_.Say(source_,
+ "Data object variable must not be a function reference"_err_en_US);
+ return false;
+ }
+ bool operator()(const evaluate::CoarrayRef &) const { // C874
+ context_.Say(
+ source_, "Data object must not be a coindexed variable"_err_en_US);
+ return false;
+ }
+
+private:
+ bool CheckSubscriptExpr(
+ const std::optional<evaluate::IndirectSubscriptIntegerExpr> &x) const {
+ return !x || CheckSubscriptExpr(*x);
+ }
+ bool CheckSubscriptExpr(
+ const evaluate::IndirectSubscriptIntegerExpr &expr) const {
+ return CheckSubscriptExpr(expr.value());
+ }
+ bool CheckSubscriptExpr(
+ const evaluate::Expr<evaluate::SubscriptInteger> &expr) const {
+ if (!evaluate::IsConstantExpr(expr)) { // C875,C881
+ context_.Say(
+ source_, "Data object must have constant subscripts"_err_en_US);
+ return false;
+ } else {
+ return true;
+ }
+ }
+
+ SemanticsContext &context_;
+ parser::CharBlock source_;
+ bool hasComponent_{false};
+ bool hasSubscript_{false};
+};
+
// TODO: C876, C877, C879
-void DataChecker::Leave(const parser::DataImpliedDo &dataImpliedDo) {
- for (const auto &object :
- std::get<std::list<parser::DataIDoObject>>(dataImpliedDo.t)) {
- if (const auto *designator{parser::Unwrap<parser::Designator>(object)}) {
- if (auto *dataRef{std::get_if<parser::DataRef>(&designator->u)}) {
- evaluate::ExpressionAnalyzer exprAnalyzer{context_};
- if (MaybeExpr checked{exprAnalyzer.Analyze(*dataRef)}) {
- if (evaluate::IsConstantExpr(*checked)) { // C878
- context_.Say(designator->source,
- "Data implied do object must be a variable"_err_en_US);
- }
- }
- if (!CheckAllSubscriptsInDataRef(*dataRef,
- designator->source)) { // C880
- context_.Say(designator->source,
- "Data implied do object must be subscripted"_err_en_US);
+void DataChecker::Leave(const parser::DataIDoObject &object) {
+ if (const auto *designator{
+ std::get_if<parser::Scalar<common::Indirection<parser::Designator>>>(
+ &object.u)}) {
+ if (MaybeExpr expr{exprAnalyzer_.Analyze(*designator)}) {
+ auto source{designator->thing.value().source};
+ if (evaluate::IsConstantExpr(*expr)) { // C878
+ exprAnalyzer_.Say(
+ source, "Data implied do object must be a variable"_err_en_US);
+ } else {
+ DataVarChecker checker{exprAnalyzer_.context(), source};
+ if (checker(*expr) && checker.HasComponentWithoutSubscripts()) { // C880
+ exprAnalyzer_.Say(source,
+ "Data implied do structure component must be subscripted"_err_en_US);
}
}
}
}
void DataChecker::Leave(const parser::DataStmtObject &dataObject) {
- if (std::get_if<common::Indirection<parser::Variable>>(&dataObject.u)) {
- if (const auto *designator{
- parser::Unwrap<parser::Designator>(dataObject)}) {
- if (auto *dataRef{std::get_if<parser::DataRef>(&designator->u)}) {
- CheckAllSubscriptsInDataRef(*dataRef, designator->source);
- }
- } else { // C875
- context_.Say(parser::FindSourceLocation(dataObject),
- "Data object variable must not be a function reference"_err_en_US);
+ if (const auto *var{
+ std::get_if<common::Indirection<parser::Variable>>(&dataObject.u)}) {
+ if (auto expr{exprAnalyzer_.Analyze(*var)}) {
+ DataVarChecker{exprAnalyzer_.context(),
+ parser::FindSourceLocation(dataObject)}(expr);
}
}
}
void DataChecker::Leave(const parser::DataStmtRepeat &dataRepeat) {
if (const auto *designator{parser::Unwrap<parser::Designator>(dataRepeat)}) {
if (auto *dataRef{std::get_if<parser::DataRef>(&designator->u)}) {
- evaluate::ExpressionAnalyzer exprAnalyzer{context_};
- if (MaybeExpr checked{exprAnalyzer.Analyze(*dataRef)}) {
- auto expr{
- evaluate::Fold(context_.foldingContext(), std::move(checked))};
+ if (MaybeExpr checked{exprAnalyzer_.Analyze(*dataRef)}) {
+ auto expr{evaluate::Fold(
+ exprAnalyzer_.GetFoldingContext(), std::move(checked))};
if (auto i64{ToInt64(expr)}) {
if (*i64 < 0) { // C882
- context_.Say(designator->source,
+ exprAnalyzer_.Say(designator->source,
"Repeat count for data value must not be negative"_err_en_US);
}
}
#include "flang/Parser/parse-tree.h"
#include "flang/Parser/tools.h"
+#include "flang/Semantics/expression.h"
#include "flang/Semantics/semantics.h"
#include "flang/Semantics/tools.h"
namespace Fortran::semantics {
class DataChecker : public virtual BaseChecker {
public:
- DataChecker(SemanticsContext &context) : context_{context} {}
+ explicit DataChecker(SemanticsContext &context) : exprAnalyzer_{context} {}
void Leave(const parser::DataStmtRepeat &);
void Leave(const parser::DataStmtConstant &);
void Leave(const parser::DataStmtObject &);
+ void Enter(const parser::DataImpliedDo &);
void Leave(const parser::DataImpliedDo &);
+ void Leave(const parser::DataIDoObject &);
private:
- SemanticsContext &context_;
+ evaluate::ExpressionAnalyzer exprAnalyzer_;
template <typename T> void CheckIfConstantSubscript(const T &);
void CheckSubscript(const parser::SectionSubscript &);
bool CheckAllSubscriptsInDataRef(const parser::DataRef &, parser::CharBlock);
// Names and named constants
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Name &n) {
- if (std::optional<int> kind{IsAcImpliedDo(n.source)}) {
+ if (std::optional<int> kind{IsImpliedDo(n.source)}) {
return AsMaybeExpr(ConvertToKind<TypeCategory::Integer>(
*kind, AsExpr(ImpliedDoIndex{n.source})));
} else if (context_.HasError(n) || !n.symbol) {
return std::nullopt;
}
+MaybeExpr ExpressionAnalyzer::Analyze(const parser::NullInit &x) {
+ return Expr<SomeType>{NullPointer{}};
+}
+
+MaybeExpr ExpressionAnalyzer::Analyze(const parser::InitialDataTarget &x) {
+ return Analyze(x.value());
+}
+
// Substring references
std::optional<Expr<SubscriptInteger>> ExpressionAnalyzer::GetSubstringBound(
const std::optional<parser::ScalarIntExpr> &bound) {
if (const auto dynamicType{DynamicType::From(symbol)}) {
kind = dynamicType->kind();
}
- if (exprAnalyzer_.AddAcImpliedDo(name, kind)) {
+ if (exprAnalyzer_.AddImpliedDo(name, kind)) {
std::optional<Expr<IntType>> lower{
GetSpecificIntExpr<IntType::kind>(bounds.lower)};
std::optional<Expr<IntType>> upper{
values_.Push(ImpliedDo<SomeType>{name, std::move(*lower),
std::move(*upper), std::move(*stride), std::move(v)});
}
- exprAnalyzer_.RemoveAcImpliedDo(name);
+ exprAnalyzer_.RemoveImpliedDo(name);
} else {
exprAnalyzer_.SayAt(name,
"Implied DO index is active in surrounding implied DO loop "
}
}
-// Common handling of parser::Expr and parser::Variable
+// Common handling of parse tree node types that retain the
+// representation of the analyzed expression.
template <typename PARSED>
MaybeExpr ExpressionAnalyzer::ExprOrVariable(const PARSED &x) {
- if (!x.typedExpr) {
+ if (x.typedExpr) {
+ return x.typedExpr->v;
+ }
+ if constexpr (std::is_same_v<PARSED, parser::Expr> ||
+ std::is_same_v<PARSED, parser::Variable>) {
FixMisparsedFunctionReference(context_, x.u);
- MaybeExpr result;
- if (AssumedTypeDummy(x)) { // C710
- Say("TYPE(*) dummy argument may only be used as an actual argument"_err_en_US);
- } else {
- if constexpr (std::is_same_v<PARSED, parser::Expr>) {
- // Analyze the expression in a specified source position context for
- // better error reporting.
- auto restorer{GetContextualMessages().SetLocation(x.source)};
- result = evaluate::Fold(foldingContext_, Analyze(x.u));
- } else {
- result = Analyze(x.u);
- }
- }
- x.typedExpr.reset(new GenericExprWrapper{std::move(result)});
- if (!x.typedExpr->v) {
- if (!context_.AnyFatalError()) {
- std::string buf;
- llvm::raw_string_ostream dump{buf};
- parser::DumpTree(dump, x);
- Say("Internal error: Expression analysis failed on: %s"_err_en_US,
- dump.str());
- }
- fatalErrors_ = true;
- }
}
- return x.typedExpr->v;
+ if (AssumedTypeDummy(x)) { // C710
+ Say("TYPE(*) dummy argument may only be used as an actual argument"_err_en_US);
+ } else if (MaybeExpr result{evaluate::Fold(foldingContext_, Analyze(x.u))}) {
+ SetExpr(x, std::move(*result));
+ return x.typedExpr->v;
+ }
+ ResetExpr(x);
+ if (!context_.AnyFatalError()) {
+ std::string buf;
+ llvm::raw_string_ostream dump{buf};
+ parser::DumpTree(dump, x);
+ Say("Internal error: Expression analysis failed on: %s"_err_en_US,
+ dump.str());
+ }
+ fatalErrors_ = true;
+ return std::nullopt;
}
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr &expr) {
return ExprOrVariable(variable);
}
+MaybeExpr ExpressionAnalyzer::Analyze(const parser::DataStmtConstant &x) {
+ auto restorer{GetContextualMessages().SetLocation(x.source)};
+ return ExprOrVariable(x);
+}
+
Expr<SubscriptInteger> ExpressionAnalyzer::AnalyzeKindSelector(
TypeCategory category,
const std::optional<parser::KindSelector> &selector) {
return false;
}
-bool ExpressionAnalyzer::AddAcImpliedDo(parser::CharBlock name, int kind) {
- return acImpliedDos_.insert(std::make_pair(name, kind)).second;
+bool ExpressionAnalyzer::AddImpliedDo(parser::CharBlock name, int kind) {
+ return impliedDos_.insert(std::make_pair(name, kind)).second;
}
-void ExpressionAnalyzer::RemoveAcImpliedDo(parser::CharBlock name) {
- auto iter{acImpliedDos_.find(name)};
- if (iter != acImpliedDos_.end()) {
- acImpliedDos_.erase(iter);
+void ExpressionAnalyzer::RemoveImpliedDo(parser::CharBlock name) {
+ auto iter{impliedDos_.find(name)};
+ if (iter != impliedDos_.end()) {
+ impliedDos_.erase(iter);
}
}
-std::optional<int> ExpressionAnalyzer::IsAcImpliedDo(
+std::optional<int> ExpressionAnalyzer::IsImpliedDo(
parser::CharBlock name) const {
- auto iter{acImpliedDos_.find(name)};
- if (iter != acImpliedDos_.cend()) {
+ auto iter{impliedDos_.find(name)};
+ if (iter != impliedDos_.cend()) {
return {iter->second};
} else {
return std::nullopt;
parser::Walk(program, *this);
return !context_.AnyFatalError();
}
-
-bool ExprChecker::Pre(const parser::DataStmtConstant &x) {
- std::visit(common::visitors{
- [&](const parser::NullInit &) {},
- [&](const parser::InitialDataTarget &y) {
- AnalyzeExpr(context_, y.value());
- },
- [&](const auto &y) { AnalyzeExpr(context_, y); },
- },
- x.u);
- return false;
-}
-
} // namespace Fortran::semantics
const Symbol &pointer, const SomeExpr &expr, SourceName source) {
auto &messages{GetFoldingContext().messages()};
auto restorer{messages.SetLocation(source)};
- if (!evaluate::IsInitialDataTarget(expr, messages)) {
+ if (!evaluate::IsInitialDataTarget(expr, &messages)) {
Say(source,
"Pointer '%s' cannot be initialized with a reference to a designator with non-constant subscripts"_err_en_US,
pointer.name());
!ERROR: Left-hand side of assignment is not modifiable
y%a(i) = 2
x%b = 4
- !ERROR: Left-hand side of assignment is not modifiable
+ !ERROR: Assignment to constant 'y%b' is not allowed
y%b = 5
end
! RUN: %B/test/Semantics/test_errors.sh %s %flang %t
!Testing data constraints : C874 - C875, C878 - C881
module m
+ integer, target :: modarray(1)
contains
function f(i)
- integer ::i
- integer ::result
- result = i *1024
+ integer, intent(in) :: i
+ integer, pointer :: f
+ f => modarray(i)
end
subroutine CheckObject
type specialNumbers
!ERROR: Data object variable must not be a function reference
DATA f(1) / 1 /
!C875
- !ERROR: Data object must have constant bounds
+ !ERROR: Data object must have constant subscripts
DATA b(ind) / 1 /
!C875
- !ERROR: Data object must have constant bounds
+ !ERROR: Data object must have constant subscripts
DATA name( : ind) / 'Ancd' /
!C875
- !ERROR: Data object must have constant bounds
+ !ERROR: Data object must have constant subscripts
DATA name(ind:) / 'Ancd' /
!C878
!ERROR: Data implied do object must be a variable
DATA(newNumsArray(i), i = 1, 2) &
/ specialNumbers(1, 2 * (/ 1, 2, 3, 4, 5 /)) /
!C880
- !ERROR: Data implied do object must be subscripted
+ !ERROR: Data implied do structure component must be subscripted
DATA(nums % one, i = 1, 5) / 5 * 1 /
!C880
!OK: Correct use
!OK: Correct use
DATA(largeNumber % numsArray(j) % one, j = 1, 10) / 10 * 1 /
!C881
- !ERROR: Data object must have constant bounds
+ !ERROR: Data object must have constant subscripts
DATA(b(x), i = 1, 5) / 5 * 1 /
!C881
!OK: Correct use