Skip to content

Commit c42f631

Browse files
klauslerklausler
committed
[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@e82cfee Reviewed-on: flang-compiler/f18#1086
1 parent 55a5009 commit c42f631

File tree

11 files changed

+727
-241
lines changed

11 files changed

+727
-241
lines changed

‎flang/include/flang/Semantics/symbol.h

+18-8
Original file line numberDiff line numberDiff line change
@@ -61,6 +61,9 @@ class SubprogramDetails {
6161
bool isFunction() const { return result_ != nullptr; }
6262
bool isInterface() const { return isInterface_; }
6363
void set_isInterface(bool value = true) { isInterface_ = value; }
64+
Scope *entryScope() { return entryScope_; }
65+
const Scope *entryScope() const { return entryScope_; }
66+
void set_entryScope(Scope &scope) { entryScope_ = &scope; }
6467
MaybeExpr bindName() const { return bindName_; }
6568
void set_bindName(MaybeExpr &&expr) { bindName_ = std::move(expr); }
6669
const Symbol &result() const {
@@ -82,8 +85,10 @@ class SubprogramDetails {
8285
MaybeExpr bindName_;
8386
std::vector<Symbol *> dummyArgs_; // nullptr -> alternate return indicator
8487
Symbol *result_{nullptr};
88+
Scope *entryScope_{nullptr}; // if ENTRY, points to subprogram's scope
8589
MaybeExpr stmtFunction_;
86-
friend llvm::raw_ostream &operator<<(llvm::raw_ostream &, const SubprogramDetails &);
90+
friend llvm::raw_ostream &operator<<(
91+
llvm::raw_ostream &, const SubprogramDetails &);
8792
};
8893

8994
// For SubprogramNameDetails, the kind indicates whether it is the name
@@ -115,17 +120,19 @@ class EntityDetails {
115120
void set_type(const DeclTypeSpec &);
116121
void ReplaceType(const DeclTypeSpec &);
117122
bool isDummy() const { return isDummy_; }
123+
void set_isDummy(bool value = true) { isDummy_ = value; }
118124
bool isFuncResult() const { return isFuncResult_; }
119125
void set_funcResult(bool x) { isFuncResult_ = x; }
120126
MaybeExpr bindName() const { return bindName_; }
121127
void set_bindName(MaybeExpr &&expr) { bindName_ = std::move(expr); }
122128

123129
private:
124-
bool isDummy_;
130+
bool isDummy_{false};
125131
bool isFuncResult_{false};
126132
const DeclTypeSpec *type_{nullptr};
127133
MaybeExpr bindName_;
128-
friend llvm::raw_ostream &operator<<(llvm::raw_ostream &, const EntityDetails &);
134+
friend llvm::raw_ostream &operator<<(
135+
llvm::raw_ostream &, const EntityDetails &);
129136
};
130137

131138
// Symbol is associated with a name or expression in a SELECT TYPE or ASSOCIATE.
@@ -180,7 +187,8 @@ class ObjectEntityDetails : public EntityDetails {
180187
ArraySpec shape_;
181188
ArraySpec coshape_;
182189
const Symbol *commonBlock_{nullptr}; // common block this object is in
183-
friend llvm::raw_ostream &operator<<(llvm::raw_ostream &, const ObjectEntityDetails &);
190+
friend llvm::raw_ostream &operator<<(
191+
llvm::raw_ostream &, const ObjectEntityDetails &);
184192
};
185193

186194
// Mixin for details with passed-object dummy argument.
@@ -217,7 +225,8 @@ class ProcEntityDetails : public EntityDetails, public WithPassArg {
217225
private:
218226
ProcInterface interface_;
219227
std::optional<const Symbol *> init_;
220-
friend llvm::raw_ostream &operator<<(llvm::raw_ostream &, const ProcEntityDetails &);
228+
friend llvm::raw_ostream &operator<<(
229+
llvm::raw_ostream &, const ProcEntityDetails &);
221230
};
222231

223232
// These derived type details represent the characteristics of a derived
@@ -263,7 +272,8 @@ class DerivedTypeDetails {
263272
std::list<SourceName> componentNames_;
264273
bool sequence_{false};
265274
bool isForwardReferenced_{false};
266-
friend llvm::raw_ostream &operator<<(llvm::raw_ostream &, const DerivedTypeDetails &);
275+
friend llvm::raw_ostream &operator<<(
276+
llvm::raw_ostream &, const DerivedTypeDetails &);
267277
};
268278

269279
class ProcBindingDetails : public WithPassArg {
@@ -570,7 +580,6 @@ class Symbol {
570580
bool IsFuncResult() const;
571581
bool IsObjectArray() const;
572582
bool IsSubprogram() const;
573-
bool IsSeparateModuleProc() const;
574583
bool IsFromModFile() const;
575584
bool HasExplicitInterface() const {
576585
return std::visit(
@@ -662,7 +671,8 @@ class Symbol {
662671
Symbol() {} // only created in class Symbols
663672
const std::string GetDetailsName() const;
664673
friend llvm::raw_ostream &operator<<(llvm::raw_ostream &, const Symbol &);
665-
friend llvm::raw_ostream &DumpForUnparse(llvm::raw_ostream &, const Symbol &, bool);
674+
friend llvm::raw_ostream &DumpForUnparse(
675+
llvm::raw_ostream &, const Symbol &, bool);
666676

667677
// If a derived type's symbol refers to an extended derived type,
668678
// return the parent component's symbol. The scope of the derived type

‎flang/include/flang/Semantics/tools.h

+7-1
Original file line numberDiff line numberDiff line change
@@ -108,6 +108,7 @@ bool IsSaved(const Symbol &);
108108
bool CanBeTypeBoundProc(const Symbol *);
109109
bool IsInitialized(const Symbol &);
110110
bool HasIntrinsicTypeName(const Symbol &);
111+
bool IsSeparateModuleProcedureInterface(const Symbol *);
111112

112113
// Return an ultimate component of type that matches predicate, or nullptr.
113114
const Symbol *FindUltimateComponent(const DerivedTypeSpec &type,
@@ -164,7 +165,7 @@ inline bool IsAssumedRankArray(const Symbol &symbol) {
164165
return details && details->IsAssumedRank();
165166
}
166167
bool IsAssumedLengthCharacter(const Symbol &);
167-
bool IsAssumedLengthExternalCharacterFunction(const Symbol &);
168+
bool IsExternal(const Symbol &);
168169
// Is the symbol modifiable in this scope
169170
std::optional<parser::MessageFixedText> WhyNotModifiable(
170171
const Symbol &, const Scope &);
@@ -200,6 +201,11 @@ std::list<SourceName> OrderParameterNames(const Symbol &);
200201
const DeclTypeSpec &FindOrInstantiateDerivedType(Scope &, DerivedTypeSpec &&,
201202
SemanticsContext &, DeclTypeSpec::Category = DeclTypeSpec::TypeDerived);
202203

204+
// When a subprogram defined in a submodule defines a separate module
205+
// procedure whose interface is defined in an ancestor (sub)module,
206+
// returns a pointer to that interface, else null.
207+
const Symbol *FindSeparateModuleSubprogramInterface(const Symbol *);
208+
203209
// Determines whether an object might be visible outside a
204210
// pure function (C1594); returns a non-null Symbol pointer for
205211
// diagnostic purposes if so.

‎flang/lib/Semantics/check-declarations.cpp

+74-7
Original file line numberDiff line numberDiff line change
@@ -24,6 +24,7 @@ namespace Fortran::semantics {
2424
using evaluate::characteristics::DummyArgument;
2525
using evaluate::characteristics::DummyDataObject;
2626
using evaluate::characteristics::DummyProcedure;
27+
using evaluate::characteristics::FunctionResult;
2728
using evaluate::characteristics::Procedure;
2829

2930
class CheckHelper {
@@ -109,6 +110,7 @@ class CheckHelper {
109110
}
110111
}
111112
}
113+
bool IsResultOkToDiffer(const FunctionResult &);
112114

113115
SemanticsContext &context_;
114116
evaluate::FoldingContext &foldingContext_{context_.foldingContext()};
@@ -208,7 +210,8 @@ void CheckHelper::Check(const Symbol &symbol) {
208210
}
209211
if (type) { // Section 7.2, paragraph 7
210212
bool canHaveAssumedParameter{IsNamedConstant(symbol) ||
211-
IsAssumedLengthExternalCharacterFunction(symbol) || // C722
213+
(IsAssumedLengthCharacter(symbol) && // C722
214+
IsExternal(symbol)) ||
212215
symbol.test(Symbol::Flag::ParentComp)};
213216
if (!IsStmtFunctionDummy(symbol)) { // C726
214217
if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
@@ -239,7 +242,7 @@ void CheckHelper::Check(const Symbol &symbol) {
239242
}
240243
}
241244
}
242-
if (IsAssumedLengthExternalCharacterFunction(symbol)) { // C723
245+
if (IsAssumedLengthCharacter(symbol) && IsExternal(symbol)) { // C723
243246
if (symbol.attrs().test(Attr::RECURSIVE)) {
244247
messages_.Say(
245248
"An assumed-length CHARACTER(*) function cannot be RECURSIVE"_err_en_US);
@@ -270,6 +273,16 @@ void CheckHelper::Check(const Symbol &symbol) {
270273
symbol.Rank() == 0) { // C830
271274
messages_.Say("CONTIGUOUS POINTER must be an array"_err_en_US);
272275
}
276+
if (IsDummy(symbol)) {
277+
if (IsNamedConstant(symbol)) {
278+
messages_.Say(
279+
"A dummy argument may not also be a named constant"_err_en_US);
280+
}
281+
if (IsSaved(symbol)) {
282+
messages_.Say(
283+
"A dummy argument may not have the SAVE attribute"_err_en_US);
284+
}
285+
}
273286
}
274287

275288
void CheckHelper::CheckValue(
@@ -600,12 +613,66 @@ class SubprogramMatchHelper {
600613
SemanticsContext &context;
601614
};
602615

616+
// 15.6.2.6 para 3 - can the result of an ENTRY differ from its function?
617+
bool CheckHelper::IsResultOkToDiffer(const FunctionResult &result) {
618+
if (result.attrs.test(FunctionResult::Attr::Allocatable) ||
619+
result.attrs.test(FunctionResult::Attr::Pointer)) {
620+
return false;
621+
}
622+
const auto *typeAndShape{result.GetTypeAndShape()};
623+
if (!typeAndShape || typeAndShape->Rank() != 0) {
624+
return false;
625+
}
626+
auto category{typeAndShape->type().category()};
627+
if (category == TypeCategory::Character ||
628+
category == TypeCategory::Derived) {
629+
return false;
630+
}
631+
int kind{typeAndShape->type().kind()};
632+
return kind == context_.GetDefaultKind(category) ||
633+
(category == TypeCategory::Real &&
634+
kind == context_.doublePrecisionKind());
635+
}
636+
603637
void CheckHelper::CheckSubprogram(
604-
const Symbol &symbol, const SubprogramDetails &) {
605-
const Scope &scope{symbol.owner()};
606-
if (symbol.attrs().test(Attr::MODULE) && scope.IsSubmodule()) {
607-
if (const Symbol * iface{scope.parent().FindSymbol(symbol.name())}) {
608-
SubprogramMatchHelper{context_}.Check(symbol, *iface);
638+
const Symbol &symbol, const SubprogramDetails &details) {
639+
if (const Symbol * iface{FindSeparateModuleSubprogramInterface(&symbol)}) {
640+
SubprogramMatchHelper{context_}.Check(symbol, *iface);
641+
}
642+
if (const Scope * entryScope{details.entryScope()}) {
643+
// ENTRY 15.6.2.6, esp. C1571
644+
std::optional<parser::MessageFixedText> error;
645+
const Symbol *subprogram{entryScope->symbol()};
646+
const SubprogramDetails *subprogramDetails{nullptr};
647+
if (subprogram) {
648+
subprogramDetails = subprogram->detailsIf<SubprogramDetails>();
649+
}
650+
if (entryScope->kind() != Scope::Kind::Subprogram) {
651+
error = "ENTRY may appear only in a subroutine or function"_err_en_US;
652+
} else if (!(entryScope->parent().IsGlobal() ||
653+
entryScope->parent().IsModule() ||
654+
entryScope->parent().IsSubmodule())) {
655+
error = "ENTRY may not appear in an internal subprogram"_err_en_US;
656+
} else if (FindSeparateModuleSubprogramInterface(subprogram)) {
657+
error = "ENTRY may not appear in a separate module procedure"_err_en_US;
658+
} else if (subprogramDetails && details.isFunction() &&
659+
subprogramDetails->isFunction()) {
660+
auto result{FunctionResult::Characterize(
661+
details.result(), context_.intrinsics())};
662+
auto subpResult{FunctionResult::Characterize(
663+
subprogramDetails->result(), context_.intrinsics())};
664+
if (result && subpResult && *result != *subpResult &&
665+
(!IsResultOkToDiffer(*result) || !IsResultOkToDiffer(*subpResult))) {
666+
error =
667+
"Result of ENTRY is not compatible with result of containing function"_err_en_US;
668+
}
669+
}
670+
if (error) {
671+
if (auto *msg{messages_.Say(symbol.name(), *error)}) {
672+
if (subprogram) {
673+
msg->Attach(subprogram->name(), "Containing subprogram"_en_US);
674+
}
675+
}
609676
}
610677
}
611678
}

‎flang/lib/Semantics/expression.cpp

+3-2
Original file line numberDiff line numberDiff line change
@@ -1889,7 +1889,7 @@ void ExpressionAnalyzer::CheckForBadRecursion(
18891889
if (proc.attrs().test(semantics::Attr::NON_RECURSIVE)) { // 15.6.2.1(3)
18901890
msg = Say("NON_RECURSIVE procedure '%s' cannot call itself"_err_en_US,
18911891
callSite);
1892-
} else if (IsAssumedLengthExternalCharacterFunction(proc)) {
1892+
} else if (IsAssumedLengthCharacter(proc) && IsExternal(proc)) {
18931893
msg = Say( // 15.6.2.1(3)
18941894
"Assumed-length CHARACTER(*) function '%s' cannot call itself"_err_en_US,
18951895
callSite);
@@ -2046,7 +2046,8 @@ static bool IsExternalCalledImplicitly(
20462046
if (const auto *symbol{proc.GetSymbol()}) {
20472047
return symbol->has<semantics::SubprogramDetails>() &&
20482048
symbol->owner().IsGlobal() &&
2049-
!symbol->scope()->sourceRange().Contains(callSite);
2049+
(!symbol->scope() /*ENTRY*/ ||
2050+
!symbol->scope()->sourceRange().Contains(callSite));
20502051
} else {
20512052
return false;
20522053
}

‎flang/lib/Semantics/mod-file.cpp

+8-6
Original file line numberDiff line numberDiff line change
@@ -69,8 +69,8 @@ static std::string CheckSum(const std::string_view &);
6969
// Collect symbols needed for a subprogram interface
7070
class SubprogramSymbolCollector {
7171
public:
72-
SubprogramSymbolCollector(const Symbol &symbol)
73-
: symbol_{symbol}, scope_{DEREF(symbol.scope())} {}
72+
SubprogramSymbolCollector(const Symbol &symbol, const Scope &scope)
73+
: symbol_{symbol}, scope_{scope} {}
7474
const SymbolVector &symbols() const { return need_; }
7575
const std::set<SourceName> &imports() const { return imports_; }
7676
void Collect();
@@ -335,12 +335,14 @@ void ModFileWriter::PutSubprogram(const Symbol &symbol) {
335335
}
336336
os << '\n';
337337

338-
// walk symbols, collect ones needed
339-
ModFileWriter writer{context_};
338+
// walk symbols, collect ones needed for interface
339+
const Scope &scope{
340+
details.entryScope() ? *details.entryScope() : DEREF(symbol.scope())};
341+
SubprogramSymbolCollector collector{symbol, scope};
342+
collector.Collect();
340343
std::string typeBindingsBuf;
341344
llvm::raw_string_ostream typeBindings{typeBindingsBuf};
342-
SubprogramSymbolCollector collector{symbol};
343-
collector.Collect();
345+
ModFileWriter writer{context_};
344346
for (const Symbol &need : collector.symbols()) {
345347
writer.PutSymbol(typeBindings, need);
346348
}

0 commit comments

Comments
 (0)