forked from OSchip/llvm-project
[flang] Semantics for ENTRY
initial test passes Move some checks to check-declarations Fix bugs found in testing Get tests all passing Allow declaration statements for function result to follow ENTRY Fix another bug Original-commit: flang-compiler/f18@e82cfee432 Reviewed-on: https://github.com/flang-compiler/f18/pull/1086
This commit is contained in:
peter klausler
parent
55a500989a
commit
c42f6314eb
|
|
@ -61,6 +61,9 @@ public:
|
|||
bool isFunction() const { return result_ != nullptr; }
|
||||
bool isInterface() const { return isInterface_; }
|
||||
void set_isInterface(bool value = true) { isInterface_ = value; }
|
||||
Scope *entryScope() { return entryScope_; }
|
||||
const Scope *entryScope() const { return entryScope_; }
|
||||
void set_entryScope(Scope &scope) { entryScope_ = &scope; }
|
||||
MaybeExpr bindName() const { return bindName_; }
|
||||
void set_bindName(MaybeExpr &&expr) { bindName_ = std::move(expr); }
|
||||
const Symbol &result() const {
|
||||
|
|
@ -82,8 +85,10 @@ private:
|
|||
MaybeExpr bindName_;
|
||||
std::vector<Symbol *> dummyArgs_; // nullptr -> alternate return indicator
|
||||
Symbol *result_{nullptr};
|
||||
Scope *entryScope_{nullptr}; // if ENTRY, points to subprogram's scope
|
||||
MaybeExpr stmtFunction_;
|
||||
friend llvm::raw_ostream &operator<<(llvm::raw_ostream &, const SubprogramDetails &);
|
||||
friend llvm::raw_ostream &operator<<(
|
||||
llvm::raw_ostream &, const SubprogramDetails &);
|
||||
};
|
||||
|
||||
// For SubprogramNameDetails, the kind indicates whether it is the name
|
||||
|
|
@ -115,17 +120,19 @@ public:
|
|||
void set_type(const DeclTypeSpec &);
|
||||
void ReplaceType(const DeclTypeSpec &);
|
||||
bool isDummy() const { return isDummy_; }
|
||||
void set_isDummy(bool value = true) { isDummy_ = value; }
|
||||
bool isFuncResult() const { return isFuncResult_; }
|
||||
void set_funcResult(bool x) { isFuncResult_ = x; }
|
||||
MaybeExpr bindName() const { return bindName_; }
|
||||
void set_bindName(MaybeExpr &&expr) { bindName_ = std::move(expr); }
|
||||
|
||||
private:
|
||||
bool isDummy_;
|
||||
bool isDummy_{false};
|
||||
bool isFuncResult_{false};
|
||||
const DeclTypeSpec *type_{nullptr};
|
||||
MaybeExpr bindName_;
|
||||
friend llvm::raw_ostream &operator<<(llvm::raw_ostream &, const EntityDetails &);
|
||||
friend llvm::raw_ostream &operator<<(
|
||||
llvm::raw_ostream &, const EntityDetails &);
|
||||
};
|
||||
|
||||
// Symbol is associated with a name or expression in a SELECT TYPE or ASSOCIATE.
|
||||
|
|
@ -180,7 +187,8 @@ private:
|
|||
ArraySpec shape_;
|
||||
ArraySpec coshape_;
|
||||
const Symbol *commonBlock_{nullptr}; // common block this object is in
|
||||
friend llvm::raw_ostream &operator<<(llvm::raw_ostream &, const ObjectEntityDetails &);
|
||||
friend llvm::raw_ostream &operator<<(
|
||||
llvm::raw_ostream &, const ObjectEntityDetails &);
|
||||
};
|
||||
|
||||
// Mixin for details with passed-object dummy argument.
|
||||
|
|
@ -217,7 +225,8 @@ public:
|
|||
private:
|
||||
ProcInterface interface_;
|
||||
std::optional<const Symbol *> init_;
|
||||
friend llvm::raw_ostream &operator<<(llvm::raw_ostream &, const ProcEntityDetails &);
|
||||
friend llvm::raw_ostream &operator<<(
|
||||
llvm::raw_ostream &, const ProcEntityDetails &);
|
||||
};
|
||||
|
||||
// These derived type details represent the characteristics of a derived
|
||||
|
|
@ -263,7 +272,8 @@ private:
|
|||
std::list<SourceName> componentNames_;
|
||||
bool sequence_{false};
|
||||
bool isForwardReferenced_{false};
|
||||
friend llvm::raw_ostream &operator<<(llvm::raw_ostream &, const DerivedTypeDetails &);
|
||||
friend llvm::raw_ostream &operator<<(
|
||||
llvm::raw_ostream &, const DerivedTypeDetails &);
|
||||
};
|
||||
|
||||
class ProcBindingDetails : public WithPassArg {
|
||||
|
|
@ -570,7 +580,6 @@ public:
|
|||
bool IsFuncResult() const;
|
||||
bool IsObjectArray() const;
|
||||
bool IsSubprogram() const;
|
||||
bool IsSeparateModuleProc() const;
|
||||
bool IsFromModFile() const;
|
||||
bool HasExplicitInterface() const {
|
||||
return std::visit(
|
||||
|
|
@ -662,7 +671,8 @@ private:
|
|||
Symbol() {} // only created in class Symbols
|
||||
const std::string GetDetailsName() const;
|
||||
friend llvm::raw_ostream &operator<<(llvm::raw_ostream &, const Symbol &);
|
||||
friend llvm::raw_ostream &DumpForUnparse(llvm::raw_ostream &, const Symbol &, bool);
|
||||
friend llvm::raw_ostream &DumpForUnparse(
|
||||
llvm::raw_ostream &, const Symbol &, bool);
|
||||
|
||||
// If a derived type's symbol refers to an extended derived type,
|
||||
// return the parent component's symbol. The scope of the derived type
|
||||
|
|
|
|||
|
|
@ -108,6 +108,7 @@ bool IsSaved(const Symbol &);
|
|||
bool CanBeTypeBoundProc(const Symbol *);
|
||||
bool IsInitialized(const Symbol &);
|
||||
bool HasIntrinsicTypeName(const Symbol &);
|
||||
bool IsSeparateModuleProcedureInterface(const Symbol *);
|
||||
|
||||
// Return an ultimate component of type that matches predicate, or nullptr.
|
||||
const Symbol *FindUltimateComponent(const DerivedTypeSpec &type,
|
||||
|
|
@ -164,7 +165,7 @@ inline bool IsAssumedRankArray(const Symbol &symbol) {
|
|||
return details && details->IsAssumedRank();
|
||||
}
|
||||
bool IsAssumedLengthCharacter(const Symbol &);
|
||||
bool IsAssumedLengthExternalCharacterFunction(const Symbol &);
|
||||
bool IsExternal(const Symbol &);
|
||||
// Is the symbol modifiable in this scope
|
||||
std::optional<parser::MessageFixedText> WhyNotModifiable(
|
||||
const Symbol &, const Scope &);
|
||||
|
|
@ -200,6 +201,11 @@ std::list<SourceName> OrderParameterNames(const Symbol &);
|
|||
const DeclTypeSpec &FindOrInstantiateDerivedType(Scope &, DerivedTypeSpec &&,
|
||||
SemanticsContext &, DeclTypeSpec::Category = DeclTypeSpec::TypeDerived);
|
||||
|
||||
// When a subprogram defined in a submodule defines a separate module
|
||||
// procedure whose interface is defined in an ancestor (sub)module,
|
||||
// returns a pointer to that interface, else null.
|
||||
const Symbol *FindSeparateModuleSubprogramInterface(const Symbol *);
|
||||
|
||||
// Determines whether an object might be visible outside a
|
||||
// pure function (C1594); returns a non-null Symbol pointer for
|
||||
// diagnostic purposes if so.
|
||||
|
|
|
|||
|
|
@ -24,6 +24,7 @@ namespace Fortran::semantics {
|
|||
using evaluate::characteristics::DummyArgument;
|
||||
using evaluate::characteristics::DummyDataObject;
|
||||
using evaluate::characteristics::DummyProcedure;
|
||||
using evaluate::characteristics::FunctionResult;
|
||||
using evaluate::characteristics::Procedure;
|
||||
|
||||
class CheckHelper {
|
||||
|
|
@ -109,6 +110,7 @@ private:
|
|||
}
|
||||
}
|
||||
}
|
||||
bool IsResultOkToDiffer(const FunctionResult &);
|
||||
|
||||
SemanticsContext &context_;
|
||||
evaluate::FoldingContext &foldingContext_{context_.foldingContext()};
|
||||
|
|
@ -208,7 +210,8 @@ void CheckHelper::Check(const Symbol &symbol) {
|
|||
}
|
||||
if (type) { // Section 7.2, paragraph 7
|
||||
bool canHaveAssumedParameter{IsNamedConstant(symbol) ||
|
||||
IsAssumedLengthExternalCharacterFunction(symbol) || // C722
|
||||
(IsAssumedLengthCharacter(symbol) && // C722
|
||||
IsExternal(symbol)) ||
|
||||
symbol.test(Symbol::Flag::ParentComp)};
|
||||
if (!IsStmtFunctionDummy(symbol)) { // C726
|
||||
if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
|
||||
|
|
@ -239,7 +242,7 @@ void CheckHelper::Check(const Symbol &symbol) {
|
|||
}
|
||||
}
|
||||
}
|
||||
if (IsAssumedLengthExternalCharacterFunction(symbol)) { // C723
|
||||
if (IsAssumedLengthCharacter(symbol) && IsExternal(symbol)) { // C723
|
||||
if (symbol.attrs().test(Attr::RECURSIVE)) {
|
||||
messages_.Say(
|
||||
"An assumed-length CHARACTER(*) function cannot be RECURSIVE"_err_en_US);
|
||||
|
|
@ -270,6 +273,16 @@ void CheckHelper::Check(const Symbol &symbol) {
|
|||
symbol.Rank() == 0) { // C830
|
||||
messages_.Say("CONTIGUOUS POINTER must be an array"_err_en_US);
|
||||
}
|
||||
if (IsDummy(symbol)) {
|
||||
if (IsNamedConstant(symbol)) {
|
||||
messages_.Say(
|
||||
"A dummy argument may not also be a named constant"_err_en_US);
|
||||
}
|
||||
if (IsSaved(symbol)) {
|
||||
messages_.Say(
|
||||
"A dummy argument may not have the SAVE attribute"_err_en_US);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
void CheckHelper::CheckValue(
|
||||
|
|
@ -600,13 +613,67 @@ private:
|
|||
SemanticsContext &context;
|
||||
};
|
||||
|
||||
// 15.6.2.6 para 3 - can the result of an ENTRY differ from its function?
|
||||
bool CheckHelper::IsResultOkToDiffer(const FunctionResult &result) {
|
||||
if (result.attrs.test(FunctionResult::Attr::Allocatable) ||
|
||||
result.attrs.test(FunctionResult::Attr::Pointer)) {
|
||||
return false;
|
||||
}
|
||||
const auto *typeAndShape{result.GetTypeAndShape()};
|
||||
if (!typeAndShape || typeAndShape->Rank() != 0) {
|
||||
return false;
|
||||
}
|
||||
auto category{typeAndShape->type().category()};
|
||||
if (category == TypeCategory::Character ||
|
||||
category == TypeCategory::Derived) {
|
||||
return false;
|
||||
}
|
||||
int kind{typeAndShape->type().kind()};
|
||||
return kind == context_.GetDefaultKind(category) ||
|
||||
(category == TypeCategory::Real &&
|
||||
kind == context_.doublePrecisionKind());
|
||||
}
|
||||
|
||||
void CheckHelper::CheckSubprogram(
|
||||
const Symbol &symbol, const SubprogramDetails &) {
|
||||
const Scope &scope{symbol.owner()};
|
||||
if (symbol.attrs().test(Attr::MODULE) && scope.IsSubmodule()) {
|
||||
if (const Symbol * iface{scope.parent().FindSymbol(symbol.name())}) {
|
||||
const Symbol &symbol, const SubprogramDetails &details) {
|
||||
if (const Symbol * iface{FindSeparateModuleSubprogramInterface(&symbol)}) {
|
||||
SubprogramMatchHelper{context_}.Check(symbol, *iface);
|
||||
}
|
||||
if (const Scope * entryScope{details.entryScope()}) {
|
||||
// ENTRY 15.6.2.6, esp. C1571
|
||||
std::optional<parser::MessageFixedText> error;
|
||||
const Symbol *subprogram{entryScope->symbol()};
|
||||
const SubprogramDetails *subprogramDetails{nullptr};
|
||||
if (subprogram) {
|
||||
subprogramDetails = subprogram->detailsIf<SubprogramDetails>();
|
||||
}
|
||||
if (entryScope->kind() != Scope::Kind::Subprogram) {
|
||||
error = "ENTRY may appear only in a subroutine or function"_err_en_US;
|
||||
} else if (!(entryScope->parent().IsGlobal() ||
|
||||
entryScope->parent().IsModule() ||
|
||||
entryScope->parent().IsSubmodule())) {
|
||||
error = "ENTRY may not appear in an internal subprogram"_err_en_US;
|
||||
} else if (FindSeparateModuleSubprogramInterface(subprogram)) {
|
||||
error = "ENTRY may not appear in a separate module procedure"_err_en_US;
|
||||
} else if (subprogramDetails && details.isFunction() &&
|
||||
subprogramDetails->isFunction()) {
|
||||
auto result{FunctionResult::Characterize(
|
||||
details.result(), context_.intrinsics())};
|
||||
auto subpResult{FunctionResult::Characterize(
|
||||
subprogramDetails->result(), context_.intrinsics())};
|
||||
if (result && subpResult && *result != *subpResult &&
|
||||
(!IsResultOkToDiffer(*result) || !IsResultOkToDiffer(*subpResult))) {
|
||||
error =
|
||||
"Result of ENTRY is not compatible with result of containing function"_err_en_US;
|
||||
}
|
||||
}
|
||||
if (error) {
|
||||
if (auto *msg{messages_.Say(symbol.name(), *error)}) {
|
||||
if (subprogram) {
|
||||
msg->Attach(subprogram->name(), "Containing subprogram"_en_US);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -1889,7 +1889,7 @@ void ExpressionAnalyzer::CheckForBadRecursion(
|
|||
if (proc.attrs().test(semantics::Attr::NON_RECURSIVE)) { // 15.6.2.1(3)
|
||||
msg = Say("NON_RECURSIVE procedure '%s' cannot call itself"_err_en_US,
|
||||
callSite);
|
||||
} else if (IsAssumedLengthExternalCharacterFunction(proc)) {
|
||||
} else if (IsAssumedLengthCharacter(proc) && IsExternal(proc)) {
|
||||
msg = Say( // 15.6.2.1(3)
|
||||
"Assumed-length CHARACTER(*) function '%s' cannot call itself"_err_en_US,
|
||||
callSite);
|
||||
|
|
@ -2046,7 +2046,8 @@ static bool IsExternalCalledImplicitly(
|
|||
if (const auto *symbol{proc.GetSymbol()}) {
|
||||
return symbol->has<semantics::SubprogramDetails>() &&
|
||||
symbol->owner().IsGlobal() &&
|
||||
!symbol->scope()->sourceRange().Contains(callSite);
|
||||
(!symbol->scope() /*ENTRY*/ ||
|
||||
!symbol->scope()->sourceRange().Contains(callSite));
|
||||
} else {
|
||||
return false;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -69,8 +69,8 @@ static std::string CheckSum(const std::string_view &);
|
|||
// Collect symbols needed for a subprogram interface
|
||||
class SubprogramSymbolCollector {
|
||||
public:
|
||||
SubprogramSymbolCollector(const Symbol &symbol)
|
||||
: symbol_{symbol}, scope_{DEREF(symbol.scope())} {}
|
||||
SubprogramSymbolCollector(const Symbol &symbol, const Scope &scope)
|
||||
: symbol_{symbol}, scope_{scope} {}
|
||||
const SymbolVector &symbols() const { return need_; }
|
||||
const std::set<SourceName> &imports() const { return imports_; }
|
||||
void Collect();
|
||||
|
|
@ -335,12 +335,14 @@ void ModFileWriter::PutSubprogram(const Symbol &symbol) {
|
|||
}
|
||||
os << '\n';
|
||||
|
||||
// walk symbols, collect ones needed
|
||||
ModFileWriter writer{context_};
|
||||
// walk symbols, collect ones needed for interface
|
||||
const Scope &scope{
|
||||
details.entryScope() ? *details.entryScope() : DEREF(symbol.scope())};
|
||||
SubprogramSymbolCollector collector{symbol, scope};
|
||||
collector.Collect();
|
||||
std::string typeBindingsBuf;
|
||||
llvm::raw_string_ostream typeBindings{typeBindingsBuf};
|
||||
SubprogramSymbolCollector collector{symbol};
|
||||
collector.Collect();
|
||||
ModFileWriter writer{context_};
|
||||
for (const Symbol &need : collector.symbols()) {
|
||||
writer.PutSymbol(typeBindings, need);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -43,7 +43,7 @@ namespace Fortran::semantics {
|
|||
|
||||
using namespace parser::literals;
|
||||
|
||||
template<typename T> using Indirection = common::Indirection<T>;
|
||||
template <typename T> using Indirection = common::Indirection<T>;
|
||||
using Message = parser::Message;
|
||||
using Messages = parser::Messages;
|
||||
using MessageFixedText = parser::MessageFixedText;
|
||||
|
|
@ -114,7 +114,7 @@ public:
|
|||
// Emit a message about a SourceName
|
||||
Message &Say(const SourceName &, MessageFixedText &&);
|
||||
// Emit a formatted message associated with a source location.
|
||||
template<typename... A>
|
||||
template <typename... A>
|
||||
Message &Say(const SourceName &source, MessageFixedText &&msg, A &&... args) {
|
||||
return context_->Say(source, std::move(msg), std::forward<A>(args)...);
|
||||
}
|
||||
|
|
@ -142,8 +142,9 @@ public:
|
|||
BaseVisitor() { DIE("BaseVisitor: default-constructed"); }
|
||||
BaseVisitor(
|
||||
SemanticsContext &c, ResolveNamesVisitor &v, ImplicitRulesMap &rules)
|
||||
: implicitRulesMap_{&rules}, this_{&v}, context_{&c}, messageHandler_{c} {}
|
||||
template<typename T> void Walk(const T &);
|
||||
: implicitRulesMap_{&rules}, this_{&v}, context_{&c}, messageHandler_{c} {
|
||||
}
|
||||
template <typename T> void Walk(const T &);
|
||||
|
||||
MessageHandler &messageHandler() { return messageHandler_; }
|
||||
const std::optional<SourceName> &currStmtSource() {
|
||||
|
|
@ -158,15 +159,15 @@ public:
|
|||
// It is not in any scope and always has MiscDetails.
|
||||
void MakePlaceholder(const parser::Name &, MiscDetails::Kind);
|
||||
|
||||
template<typename T> common::IfNoLvalue<T, T> FoldExpr(T &&expr) {
|
||||
template <typename T> common::IfNoLvalue<T, T> FoldExpr(T &&expr) {
|
||||
return evaluate::Fold(GetFoldingContext(), std::move(expr));
|
||||
}
|
||||
|
||||
template<typename T> MaybeExpr EvaluateExpr(const T &expr) {
|
||||
template <typename T> MaybeExpr EvaluateExpr(const T &expr) {
|
||||
return FoldExpr(AnalyzeExpr(*context_, expr));
|
||||
}
|
||||
|
||||
template<typename T>
|
||||
template <typename T>
|
||||
MaybeExpr EvaluateConvertedExpr(
|
||||
const Symbol &symbol, const T &expr, parser::CharBlock source) {
|
||||
if (context().HasError(symbol)) {
|
||||
|
|
@ -193,7 +194,7 @@ public:
|
|||
return FoldExpr(std::move(*converted));
|
||||
}
|
||||
|
||||
template<typename T> MaybeIntExpr EvaluateIntExpr(const T &expr) {
|
||||
template <typename T> MaybeIntExpr EvaluateIntExpr(const T &expr) {
|
||||
if (MaybeExpr maybeExpr{EvaluateExpr(expr)}) {
|
||||
if (auto *intExpr{evaluate::UnwrapExpr<SomeIntExpr>(*maybeExpr)}) {
|
||||
return std::move(*intExpr);
|
||||
|
|
@ -202,7 +203,7 @@ public:
|
|||
return std::nullopt;
|
||||
}
|
||||
|
||||
template<typename T>
|
||||
template <typename T>
|
||||
MaybeSubscriptIntExpr EvaluateSubscriptIntExpr(const T &expr) {
|
||||
if (MaybeIntExpr maybeIntExpr{EvaluateIntExpr(expr)}) {
|
||||
return FoldExpr(evaluate::ConvertToType<evaluate::SubscriptInteger>(
|
||||
|
|
@ -212,10 +213,10 @@ public:
|
|||
}
|
||||
}
|
||||
|
||||
template<typename... A> Message &Say(A &&... args) {
|
||||
template <typename... A> Message &Say(A &&... args) {
|
||||
return messageHandler_.Say(std::forward<A>(args)...);
|
||||
}
|
||||
template<typename... A>
|
||||
template <typename... A>
|
||||
Message &Say(
|
||||
const parser::Name &name, MessageFixedText &&text, const A &... args) {
|
||||
return messageHandler_.Say(name.source, std::move(text), args...);
|
||||
|
|
@ -281,16 +282,21 @@ protected:
|
|||
|
||||
Attr AccessSpecToAttr(const parser::AccessSpec &x) {
|
||||
switch (x.v) {
|
||||
case parser::AccessSpec::Kind::Public: return Attr::PUBLIC;
|
||||
case parser::AccessSpec::Kind::Private: return Attr::PRIVATE;
|
||||
case parser::AccessSpec::Kind::Public:
|
||||
return Attr::PUBLIC;
|
||||
case parser::AccessSpec::Kind::Private:
|
||||
return Attr::PRIVATE;
|
||||
}
|
||||
common::die("unreachable"); // suppress g++ warning
|
||||
}
|
||||
Attr IntentSpecToAttr(const parser::IntentSpec &x) {
|
||||
switch (x.v) {
|
||||
case parser::IntentSpec::Intent::In: return Attr::INTENT_IN;
|
||||
case parser::IntentSpec::Intent::Out: return Attr::INTENT_OUT;
|
||||
case parser::IntentSpec::Intent::InOut: return Attr::INTENT_INOUT;
|
||||
case parser::IntentSpec::Intent::In:
|
||||
return Attr::INTENT_IN;
|
||||
case parser::IntentSpec::Intent::Out:
|
||||
return Attr::INTENT_OUT;
|
||||
case parser::IntentSpec::Intent::InOut:
|
||||
return Attr::INTENT_INOUT;
|
||||
}
|
||||
common::die("unreachable"); // suppress g++ warning
|
||||
}
|
||||
|
|
@ -336,7 +342,7 @@ protected:
|
|||
}
|
||||
|
||||
// Walk the parse tree of a type spec and return the DeclTypeSpec for it.
|
||||
template<typename T>
|
||||
template <typename T>
|
||||
const DeclTypeSpec *ProcessTypeSpec(const T &x, bool allowForward = false) {
|
||||
auto restorer{common::ScopedSet(state_, State{})};
|
||||
set_allowForwardReferenceToDerivedType(allowForward);
|
||||
|
|
@ -446,6 +452,8 @@ public:
|
|||
|
||||
Scope &currScope() { return DEREF(currScope_); }
|
||||
// The enclosing scope, skipping blocks and derived types.
|
||||
// TODO: Will return the scope of a FORALL or implied DO loop; is this ok?
|
||||
// If not, should call FindProgramUnitContaining() instead.
|
||||
Scope &InclusiveScope();
|
||||
|
||||
// Create a new scope and push it on the scope stack.
|
||||
|
|
@ -454,12 +462,12 @@ public:
|
|||
void PopScope();
|
||||
void SetScope(Scope &);
|
||||
|
||||
template<typename T> bool Pre(const parser::Statement<T> &x) {
|
||||
template <typename T> bool Pre(const parser::Statement<T> &x) {
|
||||
messageHandler().set_currStmtSource(x.source);
|
||||
currScope_->AddSourceRange(x.source);
|
||||
return true;
|
||||
}
|
||||
template<typename T> void Post(const parser::Statement<T> &) {
|
||||
template <typename T> void Post(const parser::Statement<T> &) {
|
||||
messageHandler().set_currStmtSource(std::nullopt);
|
||||
}
|
||||
|
||||
|
|
@ -500,19 +508,19 @@ public:
|
|||
Symbol &MakeSymbol(const SourceName &, Attrs = Attrs{});
|
||||
Symbol &MakeSymbol(const parser::Name &, Attrs = Attrs{});
|
||||
|
||||
template<typename D>
|
||||
template <typename D>
|
||||
common::IfNoLvalue<Symbol &, D> MakeSymbol(
|
||||
const parser::Name &name, D &&details) {
|
||||
return MakeSymbol(name, Attrs{}, std::move(details));
|
||||
}
|
||||
|
||||
template<typename D>
|
||||
template <typename D>
|
||||
common::IfNoLvalue<Symbol &, D> MakeSymbol(
|
||||
const parser::Name &name, const Attrs &attrs, D &&details) {
|
||||
return Resolve(name, MakeSymbol(name.source, attrs, std::move(details)));
|
||||
}
|
||||
|
||||
template<typename D>
|
||||
template <typename D>
|
||||
common::IfNoLvalue<Symbol &, D> MakeSymbol(
|
||||
const SourceName &name, const Attrs &attrs, D &&details) {
|
||||
// Note: don't use FindSymbol here. If this is a derived type scope,
|
||||
|
|
@ -658,6 +666,8 @@ public:
|
|||
void Post(const parser::SubroutineStmt &);
|
||||
bool Pre(const parser::FunctionStmt &);
|
||||
void Post(const parser::FunctionStmt &);
|
||||
bool Pre(const parser::EntryStmt &);
|
||||
void Post(const parser::EntryStmt &);
|
||||
bool Pre(const parser::InterfaceBody::Subroutine &);
|
||||
void Post(const parser::InterfaceBody::Subroutine &);
|
||||
bool Pre(const parser::InterfaceBody::Function &);
|
||||
|
|
@ -675,6 +685,7 @@ public:
|
|||
protected:
|
||||
// Set when we see a stmt function that is really an array element assignment
|
||||
bool badStmtFuncFound_{false};
|
||||
bool inExecutionPart_{false};
|
||||
|
||||
private:
|
||||
// Info about the current function: parse tree of the type in the PrefixSpec;
|
||||
|
|
@ -687,6 +698,7 @@ private:
|
|||
} funcInfo_;
|
||||
|
||||
// Create a subprogram symbol in the current scope and push a new scope.
|
||||
void CheckExtantExternal(const parser::Name &, Symbol::Flag);
|
||||
Symbol &PushSubprogramScope(const parser::Name &, Symbol::Flag);
|
||||
Symbol *GetSpecificFromGeneric(const parser::Name &);
|
||||
SubprogramDetails &PostSubprogramStmt(const parser::Name &);
|
||||
|
|
@ -903,7 +915,7 @@ private:
|
|||
|
||||
// Declare an object or procedure entity.
|
||||
// T is one of: EntityDetails, ObjectEntityDetails, ProcEntityDetails
|
||||
template<typename T>
|
||||
template <typename T>
|
||||
Symbol &DeclareEntity(const parser::Name &name, Attrs attrs) {
|
||||
Symbol &symbol{MakeSymbol(name, attrs)};
|
||||
if (symbol.has<T>()) {
|
||||
|
|
@ -1036,10 +1048,10 @@ private:
|
|||
};
|
||||
std::vector<Association> associationStack_;
|
||||
|
||||
template<typename T> bool CheckDef(const T &t) {
|
||||
template <typename T> bool CheckDef(const T &t) {
|
||||
return CheckDef(std::get<std::optional<parser::Name>>(t));
|
||||
}
|
||||
template<typename T> void CheckRef(const T &t) {
|
||||
template <typename T> void CheckRef(const T &t) {
|
||||
CheckRef(std::get<std::optional<parser::Name>>(t));
|
||||
}
|
||||
bool CheckDef(const std::optional<parser::Name> &);
|
||||
|
|
@ -1128,8 +1140,10 @@ bool OmpVisitor::NeedsScope(const parser::OpenMPBlockConstruct &x) {
|
|||
switch (beginDir.v) {
|
||||
case parser::OmpBlockDirective::Directive::TargetData:
|
||||
case parser::OmpBlockDirective::Directive::Master:
|
||||
case parser::OmpBlockDirective::Directive::Ordered: return false;
|
||||
default: return true;
|
||||
case parser::OmpBlockDirective::Directive::Ordered:
|
||||
return false;
|
||||
default:
|
||||
return true;
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -1158,10 +1172,10 @@ public:
|
|||
SemanticsContext &context, ResolveNamesVisitor &resolver)
|
||||
: context_{context}, resolver_{resolver} {}
|
||||
|
||||
template<typename A> void Walk(const A &x) { parser::Walk(x, *this); }
|
||||
template <typename A> void Walk(const A &x) { parser::Walk(x, *this); }
|
||||
|
||||
template<typename A> bool Pre(const A &) { return true; }
|
||||
template<typename A> void Post(const A &) {}
|
||||
template <typename A> bool Pre(const A &) { return true; }
|
||||
template <typename A> void Post(const A &) {}
|
||||
|
||||
bool Pre(const parser::SpecificationPart &x) {
|
||||
Walk(std::get<std::list<parser::OpenMPDeclarativeConstruct>>(x.t));
|
||||
|
|
@ -1350,8 +1364,8 @@ public:
|
|||
}
|
||||
|
||||
// Default action for a parse tree node is to visit children.
|
||||
template<typename T> bool Pre(const T &) { return true; }
|
||||
template<typename T> void Post(const T &) {}
|
||||
template <typename T> bool Pre(const T &) { return true; }
|
||||
template <typename T> void Post(const T &) {}
|
||||
|
||||
bool Pre(const parser::SpecificationPart &);
|
||||
void Post(const parser::Program &);
|
||||
|
|
@ -1360,7 +1374,7 @@ public:
|
|||
void Post(const parser::AllocateObject &);
|
||||
bool Pre(const parser::PointerAssignmentStmt &);
|
||||
void Post(const parser::Designator &);
|
||||
template<typename A, typename B>
|
||||
template <typename A, typename B>
|
||||
void Post(const parser::LoopBounds<A, B> &x) {
|
||||
ResolveName(*parser::Unwrap<parser::Name>(x.name));
|
||||
}
|
||||
|
|
@ -1465,10 +1479,14 @@ void ImplicitRules::SetTypeMapping(const DeclTypeSpec &type,
|
|||
// Return '\0' for the char after 'z'.
|
||||
char ImplicitRules::Incr(char ch) {
|
||||
switch (ch) {
|
||||
case 'i': return 'j';
|
||||
case 'r': return 's';
|
||||
case 'z': return '\0';
|
||||
default: return ch + 1;
|
||||
case 'i':
|
||||
return 'j';
|
||||
case 'r':
|
||||
return 's';
|
||||
case 'z':
|
||||
return '\0';
|
||||
default:
|
||||
return ch + 1;
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -1491,7 +1509,7 @@ void ShowImplicitRule(
|
|||
}
|
||||
}
|
||||
|
||||
template<typename T> void BaseVisitor::Walk(const T &x) {
|
||||
template <typename T> void BaseVisitor::Walk(const T &x) {
|
||||
parser::Walk(x, *this_);
|
||||
}
|
||||
|
||||
|
|
@ -1657,14 +1675,17 @@ void DeclTypeSpecVisitor::Post(const parser::TypeSpec &typeSpec) {
|
|||
switch (spec->category()) {
|
||||
case DeclTypeSpec::Numeric:
|
||||
case DeclTypeSpec::Logical:
|
||||
case DeclTypeSpec::Character: typeSpec.declTypeSpec = spec; break;
|
||||
case DeclTypeSpec::Character:
|
||||
typeSpec.declTypeSpec = spec;
|
||||
break;
|
||||
case DeclTypeSpec::TypeDerived:
|
||||
if (const DerivedTypeSpec * derived{spec->AsDerived()}) {
|
||||
CheckForAbstractType(derived->typeSymbol()); // C703
|
||||
typeSpec.declTypeSpec = spec;
|
||||
}
|
||||
break;
|
||||
default: CRASH_NO_CASE;
|
||||
default:
|
||||
CRASH_NO_CASE;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -2732,6 +2753,7 @@ bool SubprogramVisitor::Pre(const parser::SubroutineStmt &) {
|
|||
bool SubprogramVisitor::Pre(const parser::FunctionStmt &) {
|
||||
return BeginAttrs();
|
||||
}
|
||||
bool SubprogramVisitor::Pre(const parser::EntryStmt &) { return BeginAttrs(); }
|
||||
|
||||
void SubprogramVisitor::Post(const parser::SubroutineStmt &stmt) {
|
||||
const auto &name{std::get<parser::Name>(stmt.t)};
|
||||
|
|
@ -2768,7 +2790,7 @@ void SubprogramVisitor::Post(const parser::FunctionStmt &stmt) {
|
|||
&MakeSymbol(*funcResultName, std::move(funcResultDetails));
|
||||
details.set_result(*funcInfo_.resultSymbol);
|
||||
|
||||
// C1560. TODO also enforce on entry names when entry implemented
|
||||
// C1560.
|
||||
if (funcInfo_.resultName && funcInfo_.resultName->source == name.source) {
|
||||
Say(funcInfo_.resultName->source,
|
||||
"The function name should not appear in RESULT, references to '%s' "
|
||||
|
|
@ -2782,6 +2804,9 @@ void SubprogramVisitor::Post(const parser::FunctionStmt &stmt) {
|
|||
Resolve(*funcInfo_.resultName, funcInfo_.resultSymbol);
|
||||
}
|
||||
name.symbol = currScope().symbol(); // must not be function result symbol
|
||||
// Clear the RESULT() name now in case an ENTRY statement in the implicit-part
|
||||
// has a RESULT() suffix.
|
||||
funcInfo_.resultName = nullptr;
|
||||
}
|
||||
|
||||
SubprogramDetails &SubprogramVisitor::PostSubprogramStmt(
|
||||
|
|
@ -2796,13 +2821,160 @@ SubprogramDetails &SubprogramVisitor::PostSubprogramStmt(
|
|||
return symbol.get<SubprogramDetails>();
|
||||
}
|
||||
|
||||
void SubprogramVisitor::Post(const parser::EntryStmt &stmt) {
|
||||
auto attrs{EndAttrs()}; // needs to be called even if early return
|
||||
Scope &inclusiveScope{InclusiveScope()};
|
||||
const Symbol *subprogram{inclusiveScope.symbol()};
|
||||
if (!subprogram) {
|
||||
CHECK(context().AnyFatalError());
|
||||
return;
|
||||
}
|
||||
const auto &name{std::get<parser::Name>(stmt.t)};
|
||||
const auto *parentDetails{subprogram->detailsIf<SubprogramDetails>()};
|
||||
bool inFunction{parentDetails && parentDetails->isFunction()};
|
||||
const parser::Name *resultName{funcInfo_.resultName};
|
||||
if (resultName) { // RESULT(result) is present
|
||||
funcInfo_.resultName = nullptr;
|
||||
if (!inFunction) {
|
||||
Say2(resultName->source,
|
||||
"RESULT(%s) may appear only in a function"_err_en_US,
|
||||
subprogram->name(), "Containing subprogram"_en_US);
|
||||
} else if (resultName->source == subprogram->name()) { // C1574
|
||||
Say2(resultName->source,
|
||||
"RESULT(%s) may not have the same name as the function"_err_en_US,
|
||||
subprogram->name(), "Containing function"_en_US);
|
||||
} else if (const Symbol *
|
||||
symbol{FindSymbol(inclusiveScope.parent(), *resultName)}) { // C1574
|
||||
if (const auto *details{symbol->detailsIf<SubprogramDetails>()}) {
|
||||
if (details->entryScope() == &inclusiveScope) {
|
||||
Say2(resultName->source,
|
||||
"RESULT(%s) may not have the same name as an ENTRY in the function"_err_en_US,
|
||||
symbol->name(), "Conflicting ENTRY"_en_US);
|
||||
}
|
||||
}
|
||||
}
|
||||
if (Symbol * symbol{FindSymbol(name)}) { // C1570
|
||||
// When RESULT() appears, ENTRY name can't have been already declared
|
||||
if (inclusiveScope.Contains(symbol->owner())) {
|
||||
Say2(name,
|
||||
"ENTRY name '%s' may not be declared when RESULT() is present"_err_en_US,
|
||||
*symbol, "Previous declaration of '%s'"_en_US);
|
||||
}
|
||||
}
|
||||
if (resultName->source == name.source) {
|
||||
// ignore RESULT() hereafter when it's the same name as the ENTRY
|
||||
resultName = nullptr;
|
||||
}
|
||||
}
|
||||
SubprogramDetails entryDetails;
|
||||
entryDetails.set_entryScope(inclusiveScope);
|
||||
if (inFunction) {
|
||||
// Create the entity to hold the function result, if necessary.
|
||||
Symbol *resultSymbol{nullptr};
|
||||
auto &effectiveResultName{*(resultName ? resultName : &name)};
|
||||
resultSymbol = FindInScope(currScope(), effectiveResultName);
|
||||
if (resultSymbol) { // C1574
|
||||
std::visit(
|
||||
common::visitors{[](EntityDetails &x) { x.set_funcResult(true); },
|
||||
[](ObjectEntityDetails &x) { x.set_funcResult(true); },
|
||||
[](ProcEntityDetails &x) { x.set_funcResult(true); },
|
||||
[&](const auto &) {
|
||||
Say2(effectiveResultName.source,
|
||||
"'%s' was previously declared as an item that may not be used as a function result"_err_en_US,
|
||||
resultSymbol->name(), "Previous declaration of '%s'"_en_US);
|
||||
}},
|
||||
resultSymbol->details());
|
||||
} else if (inExecutionPart_) {
|
||||
ObjectEntityDetails entity;
|
||||
entity.set_funcResult(true);
|
||||
resultSymbol = &MakeSymbol(effectiveResultName, std::move(entity));
|
||||
ApplyImplicitRules(*resultSymbol);
|
||||
} else {
|
||||
EntityDetails entity;
|
||||
entity.set_funcResult(true);
|
||||
resultSymbol = &MakeSymbol(effectiveResultName, std::move(entity));
|
||||
}
|
||||
if (!resultName) {
|
||||
name.symbol = nullptr; // symbol will be used for entry point below
|
||||
}
|
||||
entryDetails.set_result(*resultSymbol);
|
||||
}
|
||||
|
||||
for (const auto &dummyArg : std::get<std::list<parser::DummyArg>>(stmt.t)) {
|
||||
if (const auto *dummyName{std::get_if<parser::Name>(&dummyArg.u)}) {
|
||||
Symbol *dummy{FindSymbol(*dummyName)};
|
||||
if (dummy) {
|
||||
std::visit(
|
||||
common::visitors{[](EntityDetails &x) { x.set_isDummy(); },
|
||||
[](ObjectEntityDetails &x) { x.set_isDummy(); },
|
||||
[](ProcEntityDetails &x) { x.set_isDummy(); },
|
||||
[&](const auto &) {
|
||||
Say2(dummyName->source,
|
||||
"ENTRY dummy argument '%s' is previously declared as an item that may not be used as a dummy argument"_err_en_US,
|
||||
dummy->name(), "Previous declaration of '%s'"_en_US);
|
||||
}},
|
||||
dummy->details());
|
||||
} else {
|
||||
dummy = &MakeSymbol(*dummyName, EntityDetails(true));
|
||||
}
|
||||
entryDetails.add_dummyArg(*dummy);
|
||||
} else {
|
||||
if (inFunction) { // C1573
|
||||
Say(name,
|
||||
"ENTRY in a function may not have an alternate return dummy argument"_err_en_US);
|
||||
break;
|
||||
}
|
||||
entryDetails.add_alternateReturn();
|
||||
}
|
||||
}
|
||||
|
||||
Symbol::Flag subpFlag{
|
||||
inFunction ? Symbol::Flag::Function : Symbol::Flag::Subroutine};
|
||||
CheckExtantExternal(name, subpFlag);
|
||||
Scope &outer{inclusiveScope.parent()}; // global or module scope
|
||||
if (Symbol * extant{FindSymbol(outer, name)}) {
|
||||
if (extant->has<ProcEntityDetails>()) {
|
||||
if (!extant->test(subpFlag)) {
|
||||
Say2(name,
|
||||
subpFlag == Symbol::Flag::Function
|
||||
? "'%s' was previously called as a subroutine"_err_en_US
|
||||
: "'%s' was previously called as a function"_err_en_US,
|
||||
*extant, "Previous call of '%s'"_en_US);
|
||||
}
|
||||
if (extant->attrs().test(Attr::PRIVATE)) {
|
||||
attrs.set(Attr::PRIVATE);
|
||||
}
|
||||
outer.erase(extant->name());
|
||||
} else {
|
||||
if (outer.IsGlobal()) {
|
||||
Say2(name, "'%s' is already defined as a global identifier"_err_en_US,
|
||||
*extant, "Previous definition of '%s'"_en_US);
|
||||
} else {
|
||||
SayAlreadyDeclared(name, *extant);
|
||||
}
|
||||
return;
|
||||
}
|
||||
}
|
||||
if (outer.IsModule() && !attrs.test(Attr::PRIVATE)) {
|
||||
attrs.set(Attr::PUBLIC);
|
||||
}
|
||||
Symbol &entrySymbol{MakeSymbol(outer, name.source, attrs)};
|
||||
entrySymbol.set_details(std::move(entryDetails));
|
||||
if (outer.IsGlobal()) {
|
||||
MakeExternal(entrySymbol);
|
||||
}
|
||||
SetBindNameOn(entrySymbol);
|
||||
entrySymbol.set(subpFlag);
|
||||
Resolve(name, entrySymbol);
|
||||
}
|
||||
|
||||
// A subprogram declared with MODULE PROCEDURE
|
||||
bool SubprogramVisitor::BeginMpSubprogram(const parser::Name &name) {
|
||||
auto *symbol{FindSymbol(name)};
|
||||
if (symbol && symbol->has<SubprogramNameDetails>()) {
|
||||
symbol = FindSymbol(currScope().parent(), name);
|
||||
}
|
||||
if (!symbol || !symbol->IsSeparateModuleProc()) {
|
||||
if (!IsSeparateModuleProcedureInterface(symbol)) {
|
||||
Say(name, "'%s' was not declared a separate module procedure"_err_en_US);
|
||||
return false;
|
||||
}
|
||||
|
|
@ -2831,26 +3003,22 @@ bool SubprogramVisitor::BeginMpSubprogram(const parser::Name &name) {
|
|||
// A subprogram declared with SUBROUTINE or FUNCTION
|
||||
bool SubprogramVisitor::BeginSubprogram(
|
||||
const parser::Name &name, Symbol::Flag subpFlag, bool hasModulePrefix) {
|
||||
if (hasModulePrefix && !inInterfaceBlock()) {
|
||||
auto *symbol{FindSymbol(currScope().parent(), name)};
|
||||
if (!symbol || !symbol->IsSeparateModuleProc()) {
|
||||
if (hasModulePrefix && !inInterfaceBlock() &&
|
||||
!IsSeparateModuleProcedureInterface(
|
||||
FindSymbol(currScope().parent(), name))) {
|
||||
Say(name, "'%s' was not declared a separate module procedure"_err_en_US);
|
||||
return false;
|
||||
}
|
||||
}
|
||||
PushSubprogramScope(name, subpFlag);
|
||||
return true;
|
||||
}
|
||||
|
||||
void SubprogramVisitor::EndSubprogram() { PopScope(); }
|
||||
|
||||
Symbol &SubprogramVisitor::PushSubprogramScope(
|
||||
void SubprogramVisitor::CheckExtantExternal(
|
||||
const parser::Name &name, Symbol::Flag subpFlag) {
|
||||
auto *symbol{GetSpecificFromGeneric(name)};
|
||||
if (!symbol) {
|
||||
if (auto *prev{FindSymbol(name)}) {
|
||||
if (prev->attrs().test(Attr::EXTERNAL) &&
|
||||
prev->has<ProcEntityDetails>()) {
|
||||
if (prev->attrs().test(Attr::EXTERNAL) && prev->has<ProcEntityDetails>()) {
|
||||
// this subprogram was previously called, now being declared
|
||||
if (!prev->test(subpFlag)) {
|
||||
Say2(name,
|
||||
|
|
@ -2862,6 +3030,13 @@ Symbol &SubprogramVisitor::PushSubprogramScope(
|
|||
EraseSymbol(name);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
Symbol &SubprogramVisitor::PushSubprogramScope(
|
||||
const parser::Name &name, Symbol::Flag subpFlag) {
|
||||
auto *symbol{GetSpecificFromGeneric(name)};
|
||||
if (!symbol) {
|
||||
CheckExtantExternal(name, subpFlag);
|
||||
symbol = &MakeSymbol(name, SubprogramDetails{});
|
||||
}
|
||||
symbol->set(subpFlag);
|
||||
|
|
@ -5055,7 +5230,8 @@ const DeclTypeSpec &ConstructVisitor::ToDeclTypeSpec(
|
|||
|
||||
);
|
||||
}
|
||||
case common::TypeCategory::Character: CRASH_NO_CASE;
|
||||
case common::TypeCategory::Character:
|
||||
CRASH_NO_CASE;
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -5751,7 +5927,8 @@ void ResolveNamesVisitor::FinishSpecificationPart() {
|
|||
void ResolveNamesVisitor::CheckImports() {
|
||||
auto &scope{currScope()};
|
||||
switch (scope.GetImportKind()) {
|
||||
case common::ImportKind::None: break;
|
||||
case common::ImportKind::None:
|
||||
break;
|
||||
case common::ImportKind::All:
|
||||
// C8102: all entities in host must not be hidden
|
||||
for (const auto &pair : scope.parent()) {
|
||||
|
|
@ -5866,7 +6043,9 @@ bool ResolveNamesVisitor::Pre(const parser::ProgramUnit &x) {
|
|||
SetScope(context().globalScope());
|
||||
ResolveSpecificationParts(root);
|
||||
FinishSpecificationParts(root);
|
||||
inExecutionPart_ = true;
|
||||
ResolveExecutionParts(root);
|
||||
inExecutionPart_ = false;
|
||||
ResolveOmpParts(x);
|
||||
return false;
|
||||
}
|
||||
|
|
@ -5884,8 +6063,8 @@ public:
|
|||
}
|
||||
}
|
||||
|
||||
template<typename A> bool Pre(const A &) { return true; }
|
||||
template<typename A> void Post(const A &) {}
|
||||
template <typename A> bool Pre(const A &) { return true; }
|
||||
template <typename A> void Post(const A &) {}
|
||||
void Post(const parser::FunctionReference &fr) {
|
||||
resolver_.NoteExecutablePartCall(Symbol::Flag::Function, fr.v);
|
||||
}
|
||||
|
|
@ -5969,8 +6148,11 @@ bool ResolveNamesVisitor::BeginScopeForNode(const ProgramTree &node) {
|
|||
case ProgramTree::Kind::Subroutine:
|
||||
return BeginSubprogram(
|
||||
node.name(), node.GetSubpFlag(), node.HasModulePrefix());
|
||||
case ProgramTree::Kind::MpSubprogram: return BeginMpSubprogram(node.name());
|
||||
case ProgramTree::Kind::Module: BeginModule(node.name(), false); return true;
|
||||
case ProgramTree::Kind::MpSubprogram:
|
||||
return BeginMpSubprogram(node.name());
|
||||
case ProgramTree::Kind::Module:
|
||||
BeginModule(node.name(), false);
|
||||
return true;
|
||||
case ProgramTree::Kind::Submodule:
|
||||
return BeginSubmodule(node.name(), node.GetParentId());
|
||||
case ProgramTree::Kind::BlockData:
|
||||
|
|
@ -5988,10 +6170,10 @@ public:
|
|||
explicit DeferredCheckVisitor(ResolveNamesVisitor &resolver)
|
||||
: resolver_{resolver} {}
|
||||
|
||||
template<typename A> void Walk(const A &x) { parser::Walk(x, *this); }
|
||||
template <typename A> void Walk(const A &x) { parser::Walk(x, *this); }
|
||||
|
||||
template<typename A> bool Pre(const A &) { return true; }
|
||||
template<typename A> void Post(const A &) {}
|
||||
template <typename A> bool Pre(const A &) { return true; }
|
||||
template <typename A> void Post(const A &) {}
|
||||
|
||||
void Post(const parser::DerivedTypeStmt &x) {
|
||||
const auto &name{std::get<parser::Name>(x.t)};
|
||||
|
|
@ -6650,4 +6832,4 @@ void ResolveSpecificationParts(
|
|||
visitor.ResolveSpecificationParts(node);
|
||||
context.set_location(std::move(originalLocation));
|
||||
}
|
||||
}
|
||||
} // namespace Fortran::semantics
|
||||
|
|
|
|||
|
|
@ -112,10 +112,23 @@ private:
|
|||
SemanticsContext &context_;
|
||||
};
|
||||
|
||||
class EntryChecker : public virtual BaseChecker {
|
||||
public:
|
||||
explicit EntryChecker(SemanticsContext &context) : context_{context} {}
|
||||
void Leave(const parser::EntryStmt &) {
|
||||
if (!context_.constructStack().empty()) { // C1571
|
||||
context_.Say("ENTRY may not appear in an executable construct"_err_en_US);
|
||||
}
|
||||
}
|
||||
|
||||
private:
|
||||
SemanticsContext &context_;
|
||||
};
|
||||
|
||||
using StatementSemanticsPass1 = ExprChecker;
|
||||
using StatementSemanticsPass2 = SemanticsVisitor<AllocateChecker,
|
||||
ArithmeticIfStmtChecker, AssignmentChecker, CoarrayChecker, DataChecker,
|
||||
DeallocateChecker, DoForallChecker, IfStmtChecker, IoChecker,
|
||||
DeallocateChecker, DoForallChecker, EntryChecker, IfStmtChecker, IoChecker,
|
||||
NamelistChecker, NullifyChecker, OmpStructureChecker, PurityChecker,
|
||||
ReturnStmtChecker, StopChecker>;
|
||||
|
||||
|
|
|
|||
|
|
@ -92,6 +92,12 @@ llvm::raw_ostream &operator<<(
|
|||
os << ", " << x.result_->attrs();
|
||||
}
|
||||
}
|
||||
if (x.entryScope_) {
|
||||
os << " entry";
|
||||
if (x.entryScope_->symbol()) {
|
||||
os << " in " << x.entryScope_->symbol()->name();
|
||||
}
|
||||
}
|
||||
char sep{'('};
|
||||
os << ' ';
|
||||
for (const Symbol *arg : x.dummyArgs_) {
|
||||
|
|
@ -318,15 +324,6 @@ bool Symbol::IsSubprogram() const {
|
|||
details_);
|
||||
}
|
||||
|
||||
bool Symbol::IsSeparateModuleProc() const {
|
||||
if (attrs().test(Attr::MODULE)) {
|
||||
if (auto *details{detailsIf<SubprogramDetails>()}) {
|
||||
return details->isInterface();
|
||||
}
|
||||
}
|
||||
return false;
|
||||
}
|
||||
|
||||
bool Symbol::IsFromModFile() const {
|
||||
return test(Flag::ModFile) ||
|
||||
(!owner_->IsGlobal() && owner_->symbol()->IsFromModFile());
|
||||
|
|
|
|||
|
|
@ -690,6 +690,15 @@ bool HasIntrinsicTypeName(const Symbol &symbol) {
|
|||
}
|
||||
}
|
||||
|
||||
bool IsSeparateModuleProcedureInterface(const Symbol *symbol) {
|
||||
if (symbol && symbol->attrs().test(Attr::MODULE)) {
|
||||
if (auto *details{symbol->detailsIf<SubprogramDetails>()}) {
|
||||
return details->isInterface();
|
||||
}
|
||||
}
|
||||
return false;
|
||||
}
|
||||
|
||||
bool IsFinalizable(const Symbol &symbol) {
|
||||
if (const DeclTypeSpec * type{symbol.GetType()}) {
|
||||
if (const DerivedTypeSpec * derived{type->AsDerived()}) {
|
||||
|
|
@ -729,11 +738,9 @@ bool IsAssumedLengthCharacter(const Symbol &symbol) {
|
|||
|
||||
// C722 and C723: For a function to be assumed length, it must be external and
|
||||
// of CHARACTER type
|
||||
bool IsAssumedLengthExternalCharacterFunction(const Symbol &symbol) {
|
||||
return IsAssumedLengthCharacter(symbol) &&
|
||||
((symbol.has<SubprogramDetails>() && symbol.owner().IsGlobal()) ||
|
||||
(symbol.test(Symbol::Flag::Function) &&
|
||||
symbol.attrs().test(Attr::EXTERNAL)));
|
||||
bool IsExternal(const Symbol &symbol) {
|
||||
return (symbol.has<SubprogramDetails>() && symbol.owner().IsGlobal()) ||
|
||||
symbol.attrs().test(Attr::EXTERNAL);
|
||||
}
|
||||
|
||||
const Symbol *IsExternalInPureContext(
|
||||
|
|
@ -1022,6 +1029,22 @@ const DeclTypeSpec &FindOrInstantiateDerivedType(Scope &scope,
|
|||
return type;
|
||||
}
|
||||
|
||||
const Symbol *FindSeparateModuleSubprogramInterface(const Symbol *proc) {
|
||||
if (proc) {
|
||||
if (const Symbol * submodule{proc->owner().symbol()}) {
|
||||
if (const auto *details{submodule->detailsIf<ModuleDetails>()}) {
|
||||
if (const Scope * ancestor{details->ancestor()}) {
|
||||
const Symbol *iface{ancestor->FindSymbol(proc->name())};
|
||||
if (IsSeparateModuleProcedureInterface(iface)) {
|
||||
return iface;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
return nullptr;
|
||||
}
|
||||
|
||||
// ComponentIterator implementation
|
||||
|
||||
template<ComponentKind componentKind>
|
||||
|
|
|
|||
|
|
@ -14,6 +14,7 @@ end
|
|||
|
||||
! C901
|
||||
subroutine s2(x)
|
||||
!ERROR: A dummy argument may not also be a named constant
|
||||
real, parameter :: x = 0.0
|
||||
real, parameter :: a(*) = [1, 2, 3]
|
||||
character, parameter :: c(2) = "ab"
|
||||
|
|
|
|||
|
|
@ -0,0 +1,184 @@
|
|||
! RUN: %S/test_errors.sh %s %flang %t
|
||||
! Tests valid and invalid ENTRY statements
|
||||
|
||||
module m1
|
||||
!ERROR: ENTRY may appear only in a subroutine or function
|
||||
entry badentryinmodule
|
||||
interface
|
||||
module subroutine separate
|
||||
end subroutine
|
||||
end interface
|
||||
contains
|
||||
subroutine modproc
|
||||
entry entryinmodproc ! ok
|
||||
block
|
||||
!ERROR: ENTRY may not appear in an executable construct
|
||||
entry badentryinblock ! C1571
|
||||
end block
|
||||
if (.true.) then
|
||||
!ERROR: ENTRY may not appear in an executable construct
|
||||
entry ibadconstr() ! C1571
|
||||
end if
|
||||
contains
|
||||
subroutine internal
|
||||
!ERROR: ENTRY may not appear in an internal subprogram
|
||||
entry badentryininternal ! C1571
|
||||
end subroutine
|
||||
end subroutine
|
||||
end module
|
||||
|
||||
submodule(m1) m1s1
|
||||
contains
|
||||
module procedure separate
|
||||
!ERROR: ENTRY may not appear in a separate module procedure
|
||||
entry badentryinsmp ! 1571
|
||||
end procedure
|
||||
end submodule
|
||||
|
||||
program main
|
||||
!ERROR: ENTRY may appear only in a subroutine or function
|
||||
entry badentryinprogram ! C1571
|
||||
end program
|
||||
|
||||
block data bd1
|
||||
!ERROR: ENTRY may appear only in a subroutine or function
|
||||
entry badentryinbd ! C1571
|
||||
end block data
|
||||
|
||||
subroutine subr(goodarg1)
|
||||
real, intent(in) :: goodarg1
|
||||
real :: goodarg2
|
||||
!ERROR: A dummy argument may not also be a named constant
|
||||
integer, parameter :: badarg1 = 1
|
||||
type :: badarg2
|
||||
end type
|
||||
common /badarg3/ x
|
||||
namelist /badarg4/ x
|
||||
!ERROR: A dummy argument may not have the SAVE attribute
|
||||
integer :: badarg5 = 2
|
||||
entry okargs(goodarg1, goodarg2)
|
||||
!ERROR: RESULT(br1) may appear only in a function
|
||||
entry badresult() result(br1) ! C1572
|
||||
!ERROR: ENTRY dummy argument 'badarg2' is previously declared as an item that may not be used as a dummy argument
|
||||
!ERROR: ENTRY dummy argument 'badarg4' is previously declared as an item that may not be used as a dummy argument
|
||||
entry badargs(badarg1,badarg2,badarg3,badarg4,badarg5)
|
||||
end subroutine
|
||||
|
||||
function ifunc()
|
||||
integer :: ifunc
|
||||
integer :: ibad1
|
||||
type :: ibad2
|
||||
end type
|
||||
save :: ibad3
|
||||
real :: weird1
|
||||
double precision :: weird2
|
||||
complex :: weird3
|
||||
logical :: weird4
|
||||
character :: weird5
|
||||
type(ibad2) :: weird6
|
||||
integer :: iarr(1)
|
||||
integer, allocatable :: alloc
|
||||
integer, pointer :: ptr
|
||||
entry iok1()
|
||||
!ERROR: ENTRY name 'ibad1' may not be declared when RESULT() is present
|
||||
entry ibad1() result(ibad1res) ! C1570
|
||||
!ERROR: 'ibad2' was previously declared as an item that may not be used as a function result
|
||||
entry ibad2()
|
||||
!ERROR: ENTRY in a function may not have an alternate return dummy argument
|
||||
entry ibadalt(*) ! C1573
|
||||
!ERROR: RESULT(ifunc) may not have the same name as the function
|
||||
entry isameres() result(ifunc) ! C1574
|
||||
entry iok()
|
||||
!ERROR: RESULT(iok) may not have the same name as an ENTRY in the function
|
||||
entry isameres2() result(iok) ! C1574
|
||||
entry isameres3() result(iok2) ! C1574
|
||||
entry iok2()
|
||||
!These cases are all acceptably incompatible
|
||||
entry iok3() result(weird1)
|
||||
entry iok4() result(weird2)
|
||||
entry iok5() result(weird3)
|
||||
entry iok6() result(weird4)
|
||||
!ERROR: Result of ENTRY is not compatible with result of containing function
|
||||
entry ibadt1() result(weird5)
|
||||
!ERROR: Result of ENTRY is not compatible with result of containing function
|
||||
entry ibadt2() result(weird6)
|
||||
!ERROR: Result of ENTRY is not compatible with result of containing function
|
||||
entry ibadt3() result(iarr)
|
||||
!ERROR: Result of ENTRY is not compatible with result of containing function
|
||||
entry ibadt4() result(alloc)
|
||||
!ERROR: Result of ENTRY is not compatible with result of containing function
|
||||
entry ibadt5() result(ptr)
|
||||
call isubr
|
||||
!ERROR: 'isubr' was previously called as a subroutine
|
||||
entry isubr()
|
||||
continue ! force transition to execution part
|
||||
entry implicit()
|
||||
implicit = 666 ! ok, just ensure that it works
|
||||
end function
|
||||
|
||||
function chfunc() result(chr)
|
||||
character(len=1) :: chr
|
||||
character(len=2) :: chr1
|
||||
!ERROR: Result of ENTRY is not compatible with result of containing function
|
||||
entry chfunc1() result(chr1)
|
||||
end function
|
||||
|
||||
subroutine externals
|
||||
!ERROR: 'subr' is already defined as a global identifier
|
||||
entry subr
|
||||
!ERROR: 'ifunc' is already defined as a global identifier
|
||||
entry ifunc
|
||||
!ERROR: 'm1' is already defined as a global identifier
|
||||
entry m1
|
||||
!ERROR: 'iok1' is already defined as a global identifier
|
||||
entry iok1
|
||||
integer :: ix
|
||||
ix = iproc()
|
||||
!ERROR: 'iproc' was previously called as a function
|
||||
entry iproc
|
||||
end subroutine
|
||||
|
||||
module m2
|
||||
external m2entry2
|
||||
contains
|
||||
subroutine m2subr1
|
||||
entry m2entry1 ! ok
|
||||
entry m2entry2 ! ok
|
||||
entry m2entry3 ! ok
|
||||
end subroutine
|
||||
end module
|
||||
|
||||
subroutine usem2
|
||||
use m2
|
||||
interface
|
||||
subroutine simplesubr
|
||||
end subroutine
|
||||
end interface
|
||||
procedure(simplesubr), pointer :: p
|
||||
p => m2subr1 ! ok
|
||||
p => m2entry1 ! ok
|
||||
p => m2entry2 ! ok
|
||||
p => m2entry3 ! ok
|
||||
end subroutine
|
||||
|
||||
module m3
|
||||
interface
|
||||
module subroutine m3entry1
|
||||
end subroutine
|
||||
end interface
|
||||
contains
|
||||
subroutine m3subr1
|
||||
!ERROR: 'm3entry1' is already declared in this scoping unit
|
||||
entry m3entry1
|
||||
end subroutine
|
||||
end module
|
||||
|
||||
function inone
|
||||
implicit none
|
||||
integer :: inone
|
||||
!ERROR: No explicit type declared for 'implicitbad1'
|
||||
entry implicitbad1
|
||||
inone = 0 ! force transition to execution part
|
||||
!ERROR: No explicit type declared for 'implicitbad2'
|
||||
entry implicitbad2
|
||||
end
|
||||
Loading…
Reference in New Issue