template <typename T> std::string AsFortran(const T &x) {
std::string buf;
llvm::raw_string_ostream ss{buf};
- if constexpr (std::is_same_v<T, Expr>) {
+ if constexpr (HasTypedExpr<T>::value) {
if (asFortran_ && x.typedExpr) {
asFortran_->expr(ss, *x.typedExpr);
}
// R933 allocate-object -> variable-name | structure-component
struct AllocateObject {
UNION_CLASS_BOILERPLATE(AllocateObject);
+ mutable TypedExpr typedExpr;
std::variant<Name, StructureComponent> u;
};
// variable-name | structure-component | proc-pointer-name
struct PointerObject {
UNION_CLASS_BOILERPLATE(PointerObject);
+ mutable TypedExpr typedExpr;
std::variant<Name, StructureComponent> u;
};
struct HasSource<A, decltype(static_cast<void>(A::source), 0)>
: std::true_type {};
+// Detects parse tree nodes with "typedExpr" members.
+template <typename A, typename = int> struct HasTypedExpr : std::false_type {};
+template <typename A>
+struct HasTypedExpr<A, decltype(static_cast<void>(A::typedExpr), 0)>
+ : std::true_type {};
} // namespace Fortran::parser
#endif // FORTRAN_PARSER_TOOLS_H_
x.Reset(new GenericExprWrapper{std::move(expr_)},
evaluate::GenericExprWrapper::Deleter);
}
- 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());
}
template <typename T> void Set(const T &x) {
- if constexpr (ConstraintTrait<T>) {
+ if constexpr (parser::HasTypedExpr<T>::value) {
+ Set(x.typedExpr);
+ } else if constexpr (ConstraintTrait<T>) {
Set(x.thing);
} else if constexpr (WrapperTrait<T>) {
Set(x.v);
MaybeExpr Analyze(const parser::Variable &);
MaybeExpr Analyze(const parser::Designator &);
MaybeExpr Analyze(const parser::DataStmtValue &);
+ MaybeExpr Analyze(const parser::AllocateObject &);
+ MaybeExpr Analyze(const parser::PointerObject &);
template <typename A> MaybeExpr Analyze(const common::Indirection<A> &x) {
return Analyze(x.value());
exprAnalyzer_.Analyze(x);
return false;
}
+ bool Pre(const parser::AllocateObject &x) {
+ exprAnalyzer_.Analyze(x);
+ return false;
+ }
+ bool Pre(const parser::PointerObject &x) {
+ exprAnalyzer_.Analyze(x);
+ return false;
+ }
bool Pre(const parser::DataImpliedDo &);
bool Pre(const parser::CallStmt &x) {
const SomeExpr &expr, const SemanticsContext &context);
struct GetExprHelper {
+ // Specializations for parse tree nodes that have a typedExpr member.
static const SomeExpr *Get(const parser::Expr &);
static const SomeExpr *Get(const parser::Variable &);
static const SomeExpr *Get(const parser::DataStmtConstant &);
+ static const SomeExpr *Get(const parser::AllocateObject &);
+ static const SomeExpr *Get(const parser::PointerObject &);
+
template <typename T>
static const SomeExpr *Get(const common::Indirection<T> &x) {
return Get(x.value());
return x ? Get(*x) : nullptr;
}
template <typename T> static const SomeExpr *Get(const T &x) {
+ static_assert(
+ !parser::HasTypedExpr<T>::value, "explicit Get overload must be added");
if constexpr (ConstraintTrait<T>) {
return Get(x.thing);
} else if constexpr (WrapperTrait<T>) {
#include "flang/Parser/characters.h"
#include "flang/Parser/parse-tree-visitor.h"
#include "flang/Parser/parse-tree.h"
+#include "flang/Parser/tools.h"
#include "llvm/Support/raw_ostream.h"
#include <algorithm>
#include <cinttypes>
Unparse(x);
Post(x);
return false; // Walk() does not visit descendents
+ } else if constexpr (HasTypedExpr<T>::value) {
+ // Format the expression representation from semantics
+ if (asFortran_ && x.typedExpr) {
+ asFortran_->expr(out_, *x.typedExpr);
+ return false;
+ } else {
+ return true;
+ }
} else {
Before(x);
return true; // there's no Unparse() defined here, Walk() the descendents
}
// R1001 - R1022
- bool Pre(const Expr &x) {
- if (asFortran_ && x.typedExpr) {
- // Format the expression representation from semantics
- asFortran_->expr(out_, *x.typedExpr);
- return false;
- } else {
- return true;
- }
- }
void Unparse(const Expr::Parentheses &x) { Put('('), Walk(x.v), Put(')'); }
void Before(const Expr::UnaryPlus &) { Put("+"); }
void Before(const Expr::Negate &) { Put("-"); }
}
},
[&](const parser::StructureComponent &structureComponent) {
- evaluate::ExpressionAnalyzer analyzer{context_};
- if (MaybeExpr checked{analyzer.Analyze(structureComponent)}) {
+ // Only perform structureComponent checks it was successfully
+ // analyzed in expression analysis.
+ if (GetExpr(allocateObject)) {
if (!IsAllocatableOrPointer(
*structureComponent.component.symbol)) { // C932
context_.Say(structureComponent.component.source,
}
},
[&](const parser::StructureComponent &structureComponent) {
- evaluate::ExpressionAnalyzer analyzer{context_};
- if (MaybeExpr checked{analyzer.Analyze(structureComponent)}) {
+ if (const auto *checkedExpr{GetExpr(pointerObject)}) {
if (!IsPointer(*structureComponent.component.symbol)) { // C951
messages.Say(structureComponent.component.source,
"component in NULLIFY statement must have the POINTER attribute"_err_en_US);
} else if (pure) {
- if (const Symbol * symbol{GetFirstSymbol(checked)}) {
+ if (const Symbol * symbol{GetFirstSymbol(*checkedExpr)}) {
CheckDefinabilityInPureScope(
messages, *symbol, scope, *pure);
}
if (const auto *dataRef{
std::get_if<parser::DataRef>(&designator->value().u)}) {
if (const auto *name{std::get_if<parser::Name>(&dataRef->u)}) {
- if (const Symbol * symbol{name->symbol}) {
- if (const auto *type{symbol->GetType()}) {
- if (type->category() == semantics::DeclTypeSpec::TypeStar) {
- return symbol;
- }
- }
- }
+ return AssumedTypeDummy(*name);
}
}
}
return nullptr;
}
+template <>
+const Symbol *AssumedTypeDummy<parser::Name>(const parser::Name &name) {
+ if (const Symbol * symbol{name.symbol}) {
+ if (const auto *type{symbol->GetType()}) {
+ if (type->category() == semantics::DeclTypeSpec::TypeStar) {
+ return symbol;
+ }
+ }
+ }
+ return nullptr;
+}
+template <typename A>
+static const Symbol *AssumedTypePointerOrAllocatableDummy(const A &object) {
+ // It is illegal for allocatable of pointer objects to be TYPE(*), but at that
+ // point it is is not guaranteed that it has been checked the object has
+ // POINTER or ALLOCATABLE attribute, so do not assume nullptr can be directly
+ // returned.
+ return std::visit(
+ common::visitors{
+ [&](const parser::StructureComponent &x) {
+ return AssumedTypeDummy(x.component);
+ },
+ [&](const parser::Name &x) { return AssumedTypeDummy(x); },
+ },
+ object.u);
+}
+template <>
+const Symbol *AssumedTypeDummy<parser::AllocateObject>(
+ const parser::AllocateObject &x) {
+ return AssumedTypePointerOrAllocatableDummy(x);
+}
+template <>
+const Symbol *AssumedTypeDummy<parser::PointerObject>(
+ const parser::PointerObject &x) {
+ return AssumedTypePointerOrAllocatableDummy(x);
+}
MaybeExpr ExpressionAnalyzer::Analyze(const parser::FunctionReference &funcRef,
std::optional<parser::StructureConstructor> *structureConstructor) {
return ExprOrVariable(x, x.source);
}
+MaybeExpr ExpressionAnalyzer::Analyze(const parser::AllocateObject &x) {
+ parser::CharBlock source{parser::FindSourceLocation(x)};
+ auto restorer{GetContextualMessages().SetLocation(source)};
+ return ExprOrVariable(x, source);
+}
+
+MaybeExpr ExpressionAnalyzer::Analyze(const parser::PointerObject &x) {
+ parser::CharBlock source{parser::FindSourceLocation(x)};
+ auto restorer{GetContextualMessages().SetLocation(source)};
+ return ExprOrVariable(x, source);
+}
+
Expr<SubscriptInteger> ExpressionAnalyzer::AnalyzeKindSelector(
TypeCategory category,
const std::optional<parser::KindSelector> &selector) {
}
}
-const SomeExpr *GetExprHelper::Get(const parser::Expr &x) {
+template <typename T> static const SomeExpr *GetTypedExpr(const T &x) {
CheckMissingAnalysis(!x.typedExpr, x);
return common::GetPtrFromOptional(x.typedExpr->v);
}
+const SomeExpr *GetExprHelper::Get(const parser::Expr &x) {
+ return GetTypedExpr(x);
+}
const SomeExpr *GetExprHelper::Get(const parser::Variable &x) {
- CheckMissingAnalysis(!x.typedExpr, x);
- return common::GetPtrFromOptional(x.typedExpr->v);
+ return GetTypedExpr(x);
}
const SomeExpr *GetExprHelper::Get(const parser::DataStmtConstant &x) {
- CheckMissingAnalysis(!x.typedExpr, x);
- return common::GetPtrFromOptional(x.typedExpr->v);
+ return GetTypedExpr(x);
+}
+const SomeExpr *GetExprHelper::Get(const parser::AllocateObject &x) {
+ return GetTypedExpr(x);
+}
+const SomeExpr *GetExprHelper::Get(const parser::PointerObject &x) {
+ return GetTypedExpr(x);
}
const evaluate::Assignment *GetAssignment(const parser::AssignmentStmt &x) {