[flang-commits] [flang] 3a1afd8 - Rework DATA statement semantics to use typed expressions
peter klausler via flang-commits
flang-commits at lists.llvm.org
Sat Apr 25 10:30:42 PDT 2020
Author: peter klausler
Date: 2020-04-25T10:29:34-07:00
New Revision: 3a1afd8c3d4bb5ded8262697c1aaebfd96e2a319
URL: https://github.com/llvm/llvm-project/commit/3a1afd8c3d4bb5ded8262697c1aaebfd96e2a319
DIFF: https://github.com/llvm/llvm-project/commit/3a1afd8c3d4bb5ded8262697c1aaebfd96e2a319.diff
LOG: 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
Added:
Modified:
flang/include/flang/Evaluate/check-expression.h
flang/include/flang/Evaluate/expression.h
flang/include/flang/Evaluate/tools.h
flang/include/flang/Evaluate/variable.h
flang/include/flang/Parser/dump-parse-tree.h
flang/include/flang/Parser/parse-tree.h
flang/include/flang/Parser/tools.h
flang/include/flang/Semantics/expression.h
flang/lib/Evaluate/check-expression.cpp
flang/lib/Evaluate/variable.cpp
flang/lib/Parser/Fortran-parsers.cpp
flang/lib/Semantics/check-data.cpp
flang/lib/Semantics/check-data.h
flang/lib/Semantics/expression.cpp
flang/lib/Semantics/resolve-names.cpp
flang/test/Semantics/assign04.f90
flang/test/Semantics/data03.f90
Removed:
################################################################################
diff --git a/flang/include/flang/Evaluate/check-expression.h b/flang/include/flang/Evaluate/check-expression.h
index 4e93b2ab4f32..a26f83b01bbb 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<SubscriptInteger> &);
// 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
diff --git a/flang/include/flang/Evaluate/expression.h b/flang/include/flang/Evaluate/expression.h
index ebeb78f558d1..095783231b66 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<BOZLiteralConstant, NullPointer,
ProcedureDesignator, ProcedureRef>;
diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h
index d14827377b22..a149a5fe5a05 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 <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
diff --git a/flang/include/flang/Evaluate/variable.h b/flang/include/flang/Evaluate/variable.h
index d9345fbb9111..fd4f92b7f0ed 100644
--- a/flang/include/flang/Evaluate/variable.h
+++ b/flang/include/flang/Evaluate/variable.h
@@ -397,24 +397,6 @@ template <typename T> class Designator {
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;
diff --git a/flang/include/flang/Parser/dump-parse-tree.h b/flang/include/flang/Parser/dump-parse-tree.h
index 774af899de6d..ad93fcd25795 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<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.
//
@@ -789,8 +782,12 @@ class ParseTreeDumper {
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 {
@@ -838,10 +835,11 @@ class ParseTreeDumper {
};
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
diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h
index 2e5227c5f1b4..4852011c05d2 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<ObjectName>);
// 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,
@@ -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<evaluate::GenericExprWrapper,
- common::Deleter<evaluate::GenericExprWrapper>>;
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<Designator>,
common::Indirection<FunctionReference>>
diff --git a/flang/include/flang/Parser/tools.h b/flang/include/flang/Parser/tools.h
index 426222b7f7dc..94f5f2371524 100644
--- a/flang/include/flang/Parser/tools.h
+++ b/flang/include/flang/Parser/tools.h
@@ -87,5 +87,11 @@ template <typename A, typename B> A *Unwrap(B &x) {
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_
diff --git a/flang/include/flang/Semantics/expression.h b/flang/include/flang/Semantics/expression.h
index 3e5c053756b8..74552732b3ed 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 <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;
};
@@ -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 <typename T> void Set(const common::Indirection<T> &x) {
Set(x.value());
}
@@ -144,10 +130,10 @@ class ExpressionAnalyzer {
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> &);
@@ -155,6 +141,7 @@ class ExpressionAnalyzer {
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());
@@ -234,6 +221,7 @@ class ExpressionAnalyzer {
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 @@ class ExpressionAnalyzer {
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 @@ class ExpressionAnalyzer {
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;
};
@@ -438,6 +427,10 @@ class ExprChecker {
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 @@ class ExprChecker {
AnalyzePointerAssignmentStmt(context_, x);
return false;
}
- bool Pre(const parser::DataStmtConstant &);
template <typename A> bool Pre(const parser::Scalar<A> &x) {
AnalyzeExpr(context_, x);
diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp
index 4ac73131f54a..3f71cb6a1aea 100644
--- a/flang/lib/Evaluate/check-expression.cpp
+++ b/flang/lib/Evaluate/check-expression.cpp
@@ -44,6 +44,18 @@ class IsConstantExprHelper : public AllTraverse<IsConstantExprHelper, true> {
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>
@@ -68,11 +80,14 @@ template bool IsConstantExpr(const Expr<SubscriptInteger> &);
// 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; }
@@ -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<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);
}
diff --git a/flang/lib/Evaluate/variable.cpp b/flang/lib/Evaluate/variable.cpp
index 36bfee2c1f91..c7b261d27e9a 100644
--- a/flang/lib/Evaluate/variable.cpp
+++ b/flang/lib/Evaluate/variable.cpp
@@ -659,10 +659,6 @@ template <typename T>
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_;
diff --git a/flang/lib/Parser/Fortran-parsers.cpp b/flang/lib/Parser/Fortran-parsers.cpp
index fb6ab347979d..cdff9289faab 100644
--- a/flang/lib/Parser/Fortran-parsers.cpp
+++ b/flang/lib/Parser/Fortran-parsers.cpp
@@ -829,7 +829,8 @@ TYPE_PARSER(construct<DataStmtRepeat>(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<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>{}),
@@ -837,7 +838,7 @@ TYPE_PARSER(first(construct<DataStmtConstant>(scalar(Parser<ConstantValue>{})),
construct<DataStmtConstant>(signedIntLiteralConstant),
extension<LanguageFeature::SignedComplexLiteral>(
construct<DataStmtConstant>(Parser<SignedComplexLiteralConstant>{})),
- construct<DataStmtConstant>(initialDataTarget)))
+ construct<DataStmtConstant>(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 c1cc880583de..522c15aa9548 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 <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)}) {
@@ -72,7 +21,7 @@ void DataChecker::Leave(const parser::DataStmtConstant &dataConst) {
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);
}
}
@@ -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<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);
}
}
}
@@ -104,15 +133,11 @@ void DataChecker::Leave(const parser::DataImpliedDo &dataImpliedDo) {
}
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);
}
}
}
@@ -120,13 +145,12 @@ void DataChecker::Leave(const parser::DataStmtObject &dataObject) {
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);
}
}
diff --git a/flang/lib/Semantics/check-data.h b/flang/lib/Semantics/check-data.h
index 6624574fe921..d13a768d0e80 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 <typename T> 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 d36bd6f8e1e0..3431bc05392e 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -708,7 +708,7 @@ static std::optional<Expr<SomeInteger>> MakeBareTypeParamInquiry(
// 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) {
@@ -746,6 +746,14 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::NamedConstant &n) {
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) {
@@ -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<Expr<IntType>> lower{
GetSpecificIntExpr<IntType::kind>(bounds.lower)};
std::optional<Expr<IntType>> upper{
@@ -1322,7 +1330,7 @@ void ArrayConstructorContext::Add(const parser::AcValue &x) {
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 "
@@ -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 <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) {
@@ -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<SubscriptInteger> ExpressionAnalyzer::AnalyzeKindSelector(
TypeCategory category,
const std::optional<parser::KindSelector> &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<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;
@@ -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 6417a825f482..f32fce7c743e 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 c12857c66fd2..4b7724e3f2ad 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 6548c047e438..25e6fb01b3b9 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 @@ subroutine CheckObject
!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 @@ subroutine CheckObject
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 @@ subroutine CheckObject
!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
More information about the flang-commits
mailing list