From 3a1afd8c3d4bb5ded8262697c1aaebfd96e2a319 Mon Sep 17 00:00:00 2001 From: peter klausler Date: Fri, 24 Apr 2020 13:54:11 -0700 Subject: [PATCH] Rework DATA statement semantics to use typed expressions Summary: Updates recent work on DATA statement semantic checking in flang/lib/Semantics/check-data.{h,cpp} to use the compiler's internal representation for typed expressions rather than working on the raw parse tree. Saves the analyzed expressions for DATA statement values as parse tree decorations because they'll soon be needed in lowering. Corrects wording of some error messages. Fixes a bug in constant expression checking: structure constructors are not constant expressions if they set an allocatable component to anything other than NULL. Includes infrastructure changes to make this work, some renaming to reflect the fact that the implied DO loop indices tracked by expression analysis are not (just) from array constructors, remove some dead code, and improve some comments. Reviewers: tskeith, sscalpone, jdoerfert, DavidTruby, anchu-rajendran, schweitz Reviewed By: tskeith, anchu-rajendran, schweitz Subscribers: llvm-commits, flang-commits Tags: #flang, #llvm Differential Revision: https://reviews.llvm.org/D78834 --- flang/include/flang/Evaluate/check-expression.h | 3 +- flang/include/flang/Evaluate/expression.h | 2 +- flang/include/flang/Evaluate/tools.h | 25 --- flang/include/flang/Evaluate/variable.h | 18 --- flang/include/flang/Parser/dump-parse-tree.h | 18 +-- flang/include/flang/Parser/parse-tree.h | 11 +- flang/include/flang/Parser/tools.h | 6 + flang/include/flang/Semantics/expression.h | 58 +++---- flang/lib/Evaluate/check-expression.cpp | 64 +++++--- flang/lib/Evaluate/variable.cpp | 4 - flang/lib/Parser/Fortran-parsers.cpp | 5 +- flang/lib/Semantics/check-data.cpp | 192 +++++++++++++----------- flang/lib/Semantics/check-data.h | 7 +- flang/lib/Semantics/expression.cpp | 100 ++++++------ flang/lib/Semantics/resolve-names.cpp | 2 +- flang/test/Semantics/assign04.f90 | 2 +- flang/test/Semantics/data03.f90 | 17 ++- 17 files changed, 271 insertions(+), 263 deletions(-) diff --git a/flang/include/flang/Evaluate/check-expression.h b/flang/include/flang/Evaluate/check-expression.h index 4e93b2a..a26f83b 100644 --- a/flang/include/flang/Evaluate/check-expression.h +++ b/flang/include/flang/Evaluate/check-expression.h @@ -35,7 +35,8 @@ extern template bool IsConstantExpr(const Expr &); // Checks whether an expression is an object designator with // constant addressing and no vector-valued subscript. -bool IsInitialDataTarget(const Expr &, parser::ContextualMessages &); +bool IsInitialDataTarget( + const Expr &, parser::ContextualMessages * = nullptr); // Check whether an expression is a specification expression // (10.1.11(2), C1010). Constant expressions are always valid diff --git a/flang/include/flang/Evaluate/expression.h b/flang/include/flang/Evaluate/expression.h index ebeb78f..0957832 100644 --- a/flang/include/flang/Evaluate/expression.h +++ b/flang/include/flang/Evaluate/expression.h @@ -775,7 +775,7 @@ struct NullPointer { // 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; diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h index d148273..a149a5f 100644 --- a/flang/include/flang/Evaluate/tools.h +++ b/flang/include/flang/Evaluate/tools.h @@ -28,31 +28,6 @@ namespace Fortran::evaluate { // 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 -std::optional> AsVariable(const Expr &expr) { - using Variant = decltype(Variable::u); - return std::visit( - [](const auto &x) -> std::optional> { - if constexpr (common::HasMember, Variant>) { - return Variable{x}; - } - return std::nullopt; - }, - expr.u); -} - -template -std::optional> AsVariable(const std::optional> &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 diff --git a/flang/include/flang/Evaluate/variable.h b/flang/include/flang/Evaluate/variable.h index d9345fb..fd4f92b7 100644 --- a/flang/include/flang/Evaluate/variable.h +++ b/flang/include/flang/Evaluate/variable.h @@ -397,24 +397,6 @@ public: FOR_EACH_CHARACTER_KIND(extern template class Designator, ) -template struct Variable { - using Result = T; - static_assert(IsSpecificIntrinsicType || - std::is_same_v>); - EVALUATE_UNION_CLASS_BOILERPLATE(Variable) - std::optional 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, FunctionRef> u; -}; - class DescriptorInquiry { public: using Result = SubscriptInteger; diff --git a/flang/include/flang/Parser/dump-parse-tree.h b/flang/include/flang/Parser/dump-parse-tree.h index 774af89..ad93fcd 100644 --- a/flang/include/flang/Parser/dump-parse-tree.h +++ b/flang/include/flang/Parser/dump-parse-tree.h @@ -12,6 +12,7 @@ #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" @@ -21,14 +22,6 @@ namespace Fortran::parser { -// When SHOW_ALL_SOURCE_MEMBERS is defined, HasSource::value is true if T has -// a member named source -template struct HasSource : std::false_type {}; -#ifdef SHOW_ALL_SOURCE_MEMBERS -template -struct HasSource : std::true_type {}; -#endif - // // Dump the Parse Tree hierarchy of any node 'x' of the parse tree. // @@ -789,8 +782,12 @@ protected: if (ss.tell()) { return ss.str(); } - if constexpr (std::is_same_v || HasSource::value) { + if constexpr (std::is_same_v) { return x.source.ToString(); +#ifdef SHOW_ALL_SOURCE_MEMBERS + } else if constexpr (HasSource::value) { + return x.source.ToString(); +#endif } else if constexpr (std::is_same_v) { return x; } else { @@ -838,10 +835,11 @@ private: }; template -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 diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h index 2e5227c..4852011 100644 --- a/flang/include/flang/Parser/parse-tree.h +++ b/flang/include/flang/Parser/parse-tree.h @@ -1393,12 +1393,18 @@ WRAPPER_CLASS(ContiguousStmt, std::list); // R846 int-constant-subobject -> constant-subobject using ConstantSubobject = Constant>; +// Represents an analyzed expression +using TypedExpr = std::unique_ptr>; + // 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, SignedIntLiteralConstant, SignedRealLiteralConstant, SignedComplexLiteralConstant, NullInit, InitialDataTarget, @@ -1699,9 +1705,6 @@ struct Expr { explicit Expr(Designator &&); explicit Expr(FunctionReference &&); - // Filled in with expression after successful semantic analysis. - using TypedExpr = std::unique_ptr>; mutable TypedExpr typedExpr; CharBlock source; @@ -1768,7 +1771,7 @@ struct Designator { // 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> diff --git a/flang/include/flang/Parser/tools.h b/flang/include/flang/Parser/tools.h index 426222b..94f5f237 100644 --- a/flang/include/flang/Parser/tools.h +++ b/flang/include/flang/Parser/tools.h @@ -87,5 +87,11 @@ template A *Unwrap(B &x) { const CoindexedNamedObject *GetCoindexedNamedObject(const AllocateObject &); const CoindexedNamedObject *GetCoindexedNamedObject(const DataRef &); +// Detects parse tree nodes with "source" members. +template struct HasSource : std::false_type {}; +template +struct HasSource(A::source), 0)> + : std::true_type {}; + } // namespace Fortran::parser #endif // FORTRAN_PARSER_TOOLS_H_ diff --git a/flang/include/flang/Semantics/expression.h b/flang/include/flang/Semantics/expression.h index 3e5c053..74552732 100644 --- a/flang/include/flang/Semantics/expression.h +++ b/flang/include/flang/Semantics/expression.h @@ -21,41 +21,26 @@ #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 #include +#include #include using namespace Fortran::parser::literals; namespace Fortran::parser { struct SourceLocationFindingVisitor { - template bool Pre(const A &) { return true; } - template 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 bool Pre(const UnlabeledStatement &stmt) { - source = stmt.source; - return false; + template bool Pre(const A &x) { + if constexpr (HasSource::value) { + source.ExtendToCover(x.source); + return false; + } else { + return true; + } } - void Post(const CharBlock &at) { source = at; } + template void Post(const A &) {} + void Post(const CharBlock &at) { source.ExtendToCover(at); } CharBlock source; }; @@ -84,11 +69,12 @@ class IntrinsicProcTable; 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 void Set(const common::Indirection &x) { Set(x.value()); } @@ -144,10 +130,10 @@ public: 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 IsAcImpliedDo(parser::CharBlock) const; + // Manage a set of active implied DO loops. + bool AddImpliedDo(parser::CharBlock, int); + void RemoveImpliedDo(parser::CharBlock); + std::optional IsImpliedDo(parser::CharBlock) const; Expr AnalyzeKindSelector(common::TypeCategory category, const std::optional &); @@ -155,6 +141,7 @@ public: MaybeExpr Analyze(const parser::Expr &); MaybeExpr Analyze(const parser::Variable &); MaybeExpr Analyze(const parser::Designator &); + MaybeExpr Analyze(const parser::DataStmtConstant &); template MaybeExpr Analyze(const common::Indirection &x) { return Analyze(x.value()); @@ -234,6 +221,7 @@ public: 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 &); @@ -252,6 +240,7 @@ private: 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 &); @@ -376,7 +365,7 @@ private: semantics::SemanticsContext &context_; FoldingContext &foldingContext_{context_.foldingContext()}; - std::map acImpliedDos_; // values are INTEGER kinds + std::map impliedDos_; // values are INTEGER kinds bool fatalErrors_{false}; friend class ArgumentAnalyzer; }; @@ -438,6 +427,10 @@ public: 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; @@ -450,7 +443,6 @@ public: AnalyzePointerAssignmentStmt(context_, x); return false; } - bool Pre(const parser::DataStmtConstant &); template bool Pre(const parser::Scalar &x) { AnalyzeExpr(context_, x); diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp index 4ac7313..3f71cb6 100644 --- a/flang/lib/Evaluate/check-expression.cpp +++ b/flang/lib/Evaluate/check-expression.cpp @@ -44,6 +44,18 @@ public: 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 @@ -68,11 +80,14 @@ template bool IsConstantExpr(const Expr &); // 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 { +public: using Base = AllTraverse; using Base::operator(); - explicit IsInitialDataTargetHelper(parser::ContextualMessages &m) + explicit IsInitialDataTargetHelper(parser::ContextualMessages *m) : Base{*this}, messages_{m} {} bool operator()(const BOZLiteralConstant &) const { return false; } @@ -83,21 +98,37 @@ struct IsInitialDataTargetHelper 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; } @@ -140,13 +171,12 @@ struct IsInitialDataTargetHelper return (*this)(x.left()); } bool operator()(const Relational &) const { return false; } - private: - parser::ContextualMessages &messages_; + parser::ContextualMessages *messages_; }; bool IsInitialDataTarget( - const Expr &x, parser::ContextualMessages &messages) { + const Expr &x, parser::ContextualMessages *messages) { return IsInitialDataTargetHelper{messages}(x); } diff --git a/flang/lib/Evaluate/variable.cpp b/flang/lib/Evaluate/variable.cpp index 36bfee2..c7b261d 100644 --- a/flang/lib/Evaluate/variable.cpp +++ b/flang/lib/Evaluate/variable.cpp @@ -659,10 +659,6 @@ template bool Designator::operator==(const Designator &that) const { return TestVariableEquality(*this, that); } -template -bool Variable::operator==(const Variable &that) const { - return u == that.u; -} bool DescriptorInquiry::operator==(const DescriptorInquiry &that) const { return field_ == that.field_ && base_ == that.base_ && dimension_ == that.dimension_; diff --git a/flang/lib/Parser/Fortran-parsers.cpp b/flang/lib/Parser/Fortran-parsers.cpp index fb6ab34..cdff928 100644 --- a/flang/lib/Parser/Fortran-parsers.cpp +++ b/flang/lib/Parser/Fortran-parsers.cpp @@ -829,7 +829,8 @@ TYPE_PARSER(construct(intLiteralConstant) || // null-init | initial-data-target | structure-constructor // TODO: Some structure constructors can be misrecognized as array // references into constant subobjects. -TYPE_PARSER(first(construct(scalar(Parser{})), +TYPE_PARSER(sourced(first( + construct(scalar(Parser{})), construct(nullInit), construct(scalar(constantSubobject)) / !"("_tok, construct(Parser{}), @@ -837,7 +838,7 @@ TYPE_PARSER(first(construct(scalar(Parser{})), construct(signedIntLiteralConstant), extension( construct(Parser{})), - construct(initialDataTarget))) + construct(initialDataTarget)))) // R848 dimension-stmt -> // DIMENSION [::] array-name ( array-spec ) diff --git a/flang/lib/Semantics/check-data.cpp b/flang/lib/Semantics/check-data.cpp index c1cc880..522c15a 100644 --- a/flang/lib/Semantics/check-data.cpp +++ b/flang/lib/Semantics/check-data.cpp @@ -7,62 +7,11 @@ //===----------------------------------------------------------------------===// #include "check-data.h" +#include "flang/Evaluate/traverse.h" +#include "flang/Semantics/expression.h" namespace Fortran::semantics { -template 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 - &structureComp) { - return CheckAllSubscriptsInDataRef( - structureComp.value().base, source); - }, - [&](const common::Indirection &arrayElem) { - for (auto &subscript : arrayElem.value().subscripts) { - CheckSubscript(subscript); - } - CheckAllSubscriptsInDataRef(arrayElem.value().base, source); - return true; - }, - [&](const common::Indirection - &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(&dataConst.u)}) { @@ -72,7 +21,7 @@ void DataChecker::Leave(const parser::DataStmtConstant &dataConst) { std::get(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); } } @@ -80,23 +29,103 @@ void DataChecker::Leave(const parser::DataStmtConstant &dataConst) { } } +// 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(x.t).name.thing.thing}; + int kind{evaluate::ResultType::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(x.t).name.thing.thing}; + exprAnalyzer_.RemoveImpliedDo(name.source); +} + +class DataVarChecker : public evaluate::AllTraverse { +public: + using Base = evaluate::AllTraverse; + 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 + bool operator()(const evaluate::FunctionRef &) 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 &x) const { + return !x || CheckSubscriptExpr(*x); + } + bool CheckSubscriptExpr( + const evaluate::IndirectSubscriptIntegerExpr &expr) const { + return CheckSubscriptExpr(expr.value()); + } + bool CheckSubscriptExpr( + const evaluate::Expr &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>(dataImpliedDo.t)) { - if (const auto *designator{parser::Unwrap(object)}) { - if (auto *dataRef{std::get_if(&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>>( + &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); } } } @@ -104,15 +133,11 @@ void DataChecker::Leave(const parser::DataImpliedDo &dataImpliedDo) { } void DataChecker::Leave(const parser::DataStmtObject &dataObject) { - if (std::get_if>(&dataObject.u)) { - if (const auto *designator{ - parser::Unwrap(dataObject)}) { - if (auto *dataRef{std::get_if(&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>(&dataObject.u)}) { + if (auto expr{exprAnalyzer_.Analyze(*var)}) { + DataVarChecker{exprAnalyzer_.context(), + parser::FindSourceLocation(dataObject)}(expr); } } } @@ -120,13 +145,12 @@ void DataChecker::Leave(const parser::DataStmtObject &dataObject) { void DataChecker::Leave(const parser::DataStmtRepeat &dataRepeat) { if (const auto *designator{parser::Unwrap(dataRepeat)}) { if (auto *dataRef{std::get_if(&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); } } diff --git a/flang/lib/Semantics/check-data.h b/flang/lib/Semantics/check-data.h index 6624574..d13a768 100644 --- a/flang/lib/Semantics/check-data.h +++ b/flang/lib/Semantics/check-data.h @@ -11,20 +11,23 @@ #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 void CheckIfConstantSubscript(const T &); void CheckSubscript(const parser::SectionSubscript &); bool CheckAllSubscriptsInDataRef(const parser::DataRef &, parser::CharBlock); diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp index d36bd6f..3431bc0 100644 --- a/flang/lib/Semantics/expression.cpp +++ b/flang/lib/Semantics/expression.cpp @@ -708,7 +708,7 @@ static std::optional> MakeBareTypeParamInquiry( // Names and named constants MaybeExpr ExpressionAnalyzer::Analyze(const parser::Name &n) { - if (std::optional kind{IsAcImpliedDo(n.source)}) { + if (std::optional kind{IsImpliedDo(n.source)}) { return AsMaybeExpr(ConvertToKind( *kind, AsExpr(ImpliedDoIndex{n.source}))); } else if (context_.HasError(n) || !n.symbol) { @@ -746,6 +746,14 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::NamedConstant &n) { return std::nullopt; } +MaybeExpr ExpressionAnalyzer::Analyze(const parser::NullInit &x) { + return Expr{NullPointer{}}; +} + +MaybeExpr ExpressionAnalyzer::Analyze(const parser::InitialDataTarget &x) { + return Analyze(x.value()); +} + // Substring references std::optional> ExpressionAnalyzer::GetSubstringBound( const std::optional &bound) { @@ -1302,7 +1310,7 @@ void ArrayConstructorContext::Add(const parser::AcValue &x) { if (const auto dynamicType{DynamicType::From(symbol)}) { kind = dynamicType->kind(); } - if (exprAnalyzer_.AddAcImpliedDo(name, kind)) { + if (exprAnalyzer_.AddImpliedDo(name, kind)) { std::optional> lower{ GetSpecificIntExpr(bounds.lower)}; std::optional> upper{ @@ -1322,7 +1330,7 @@ void ArrayConstructorContext::Add(const parser::AcValue &x) { values_.Push(ImpliedDo{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 " @@ -2423,37 +2431,33 @@ static void FixMisparsedFunctionReference( } } -// Common handling of parser::Expr and parser::Variable +// Common handling of parse tree node types that retain the +// representation of the analyzed expression. template MaybeExpr ExpressionAnalyzer::ExprOrVariable(const PARSED &x) { - if (!x.typedExpr) { + if (x.typedExpr) { + return x.typedExpr->v; + } + if constexpr (std::is_same_v || + std::is_same_v) { 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) { - // 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) { @@ -2466,6 +2470,11 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::Variable &variable) { return ExprOrVariable(variable); } +MaybeExpr ExpressionAnalyzer::Analyze(const parser::DataStmtConstant &x) { + auto restorer{GetContextualMessages().SetLocation(x.source)}; + return ExprOrVariable(x); +} + Expr ExpressionAnalyzer::AnalyzeKindSelector( TypeCategory category, const std::optional &selector) { @@ -2536,21 +2545,21 @@ bool ExpressionAnalyzer::CheckIntrinsicSize( 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 ExpressionAnalyzer::IsAcImpliedDo( +std::optional 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; @@ -3027,17 +3036,4 @@ bool ExprChecker::Walk(const parser::Program &program) { 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 diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp index 6417a82..f32fce7 100644 --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -5499,7 +5499,7 @@ void DeclarationVisitor::CheckInitialDataTarget( 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()); diff --git a/flang/test/Semantics/assign04.f90 b/flang/test/Semantics/assign04.f90 index c12857c..4b7724e 100644 --- a/flang/test/Semantics/assign04.f90 +++ b/flang/test/Semantics/assign04.f90 @@ -43,7 +43,7 @@ subroutine s3 !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 diff --git a/flang/test/Semantics/data03.f90 b/flang/test/Semantics/data03.f90 index 6548c04..25e6fb0 100644 --- a/flang/test/Semantics/data03.f90 +++ b/flang/test/Semantics/data03.f90 @@ -1,11 +1,12 @@ ! 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 @@ -43,13 +44,13 @@ module m !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 @@ -59,7 +60,7 @@ module m 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 @@ -68,7 +69,7 @@ module m !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 -- 2.7.4