diff --git a/flang/include/flang/Semantics/semantics.h b/flang/include/flang/Semantics/semantics.h
--- a/flang/include/flang/Semantics/semantics.h
+++ b/flang/include/flang/Semantics/semantics.h
@@ -199,7 +199,7 @@
IndexVarKind kind;
};
std::map<SymbolRef, const IndexVarInfo> activeIndexVars_;
- std::set<SymbolRef> errorSymbols_;
+ SymbolSet errorSymbols_;
std::set<std::string> tempNames_;
};
diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h
--- a/flang/include/flang/Semantics/symbol.h
+++ b/flang/include/flang/Semantics/symbol.h
@@ -15,9 +15,10 @@
#include "flang/Common/reference.h"
#include "llvm/ADT/DenseMapInfo.h"
#include <array>
+#include <functional>
#include <list>
#include <optional>
-#include <set>
+#include <unordered_set>
#include <vector>
namespace llvm {
@@ -595,7 +596,7 @@
bool operator==(const Symbol &that) const { return this == &that; }
bool operator!=(const Symbol &that) const { return !(*this == that); }
bool operator<(const Symbol &that) const {
- // For sets of symbols: collate them by source location
+ // For maps of symbols: collate them by source location
return name_.begin() < that.name_.begin();
}
@@ -765,7 +766,13 @@
inline bool operator<(MutableSymbolRef x, MutableSymbolRef y) {
return *x < *y;
}
-using SymbolSet = std::set<SymbolRef>;
+struct SymbolHash {
+ std::size_t operator()(SymbolRef symRef) const {
+ std::hash<std::string> hasher;
+ return hasher(symRef->name().ToString());
+ }
+};
+using SymbolSet = std::unordered_set<SymbolRef, SymbolHash>;
} // namespace Fortran::semantics
diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp
--- a/flang/lib/Evaluate/characteristics.cpp
+++ b/flang/lib/Evaluate/characteristics.cpp
@@ -369,7 +369,7 @@
std::string procsList{GetSeenProcs(seenProcs)};
context.messages().Say(symbol.name(),
"Procedure '%s' is recursively defined. Procedures in the cycle:"
- " '%s'"_err_en_US,
+ " %s"_err_en_US,
symbol.name(), procsList);
return std::nullopt;
}
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -1003,6 +1003,7 @@
context().SetError(symbol);
return symbol;
}
+ bool HasCycle(const Symbol &, const ProcInterface &);
};
// Resolve construct entities and statement entities.
@@ -2132,7 +2133,7 @@
void ScopeHandler::ApplyImplicitRules(
Symbol &symbol, bool allowForwardReference) {
- if (!NeedsType(symbol)) {
+ if (context().HasError(symbol) || !NeedsType(symbol)) {
return;
}
if (const DeclTypeSpec * type{GetImplicitType(symbol)}) {
@@ -3641,6 +3642,35 @@
}
}
+bool DeclarationVisitor::HasCycle(
+ const Symbol &procSymbol, const ProcInterface &interface) {
+ SymbolSet procsInCycle;
+ procsInCycle.insert(procSymbol);
+ const ProcInterface *thisInterface{&interface};
+ bool haveInterface{true};
+ while (haveInterface) {
+ haveInterface = false;
+ if (const Symbol * interfaceSymbol{thisInterface->symbol()}) {
+ if (procsInCycle.count(*interfaceSymbol) > 0) {
+ for (const auto procInCycle : procsInCycle) {
+ Say(procInCycle->name(),
+ "The interface for procedure '%s' is recursively "
+ "defined"_err_en_US,
+ procInCycle->name());
+ context().SetError(*procInCycle);
+ }
+ return true;
+ } else if (const auto *procDetails{
+ interfaceSymbol->detailsIf<ProcEntityDetails>()}) {
+ haveInterface = true;
+ thisInterface = &procDetails->interface();
+ procsInCycle.insert(*interfaceSymbol);
+ }
+ }
+ }
+ return false;
+}
+
Symbol &DeclarationVisitor::DeclareProcEntity(
const parser::Name &name, Attrs attrs, const ProcInterface &interface) {
Symbol &symbol{DeclareEntity<ProcEntityDetails>(name, attrs)};
@@ -3650,20 +3680,20 @@
"The interface for procedure '%s' has already been "
"declared"_err_en_US);
context().SetError(symbol);
- } else {
- if (interface.type()) {
+ } else if (HasCycle(symbol, interface)) {
+ return symbol;
+ } else if (interface.type()) {
+ symbol.set(Symbol::Flag::Function);
+ } else if (interface.symbol()) {
+ if (interface.symbol()->test(Symbol::Flag::Function)) {
symbol.set(Symbol::Flag::Function);
- } else if (interface.symbol()) {
- if (interface.symbol()->test(Symbol::Flag::Function)) {
- symbol.set(Symbol::Flag::Function);
- } else if (interface.symbol()->test(Symbol::Flag::Subroutine)) {
- symbol.set(Symbol::Flag::Subroutine);
- }
+ } else if (interface.symbol()->test(Symbol::Flag::Subroutine)) {
+ symbol.set(Symbol::Flag::Subroutine);
}
- details->set_interface(interface);
- SetBindNameOn(symbol);
- SetPassNameOn(symbol);
}
+ details->set_interface(interface);
+ SetBindNameOn(symbol);
+ SetPassNameOn(symbol);
}
return symbol;
}
@@ -5005,7 +5035,7 @@
void DeclarationVisitor::CheckExplicitInterface(const parser::Name &name) {
if (const Symbol * symbol{name.symbol}) {
- if (!symbol->HasExplicitInterface()) {
+ if (!context().HasError(*symbol) && !symbol->HasExplicitInterface()) {
Say(name,
"'%s' must be an abstract interface or a procedure with "
"an explicit interface"_err_en_US,
diff --git a/flang/test/Semantics/resolve102.f90 b/flang/test/Semantics/resolve102.f90
--- a/flang/test/Semantics/resolve102.f90
+++ b/flang/test/Semantics/resolve102.f90
@@ -1,7 +1,7 @@
! RUN: %S/test_errors.sh %s %t %f18
! Tests for circularly defined procedures
-!ERROR: Procedure 'sub' is recursively defined. Procedures in the cycle: ''sub', 'p2''
+!ERROR: Procedure 'sub' is recursively defined. Procedures in the cycle: 'p2', 'sub'
subroutine sub(p2)
PROCEDURE(sub) :: p2
@@ -9,7 +9,7 @@
end subroutine
subroutine circular
- !ERROR: Procedure 'p' is recursively defined. Procedures in the cycle: ''p', 'sub', 'p2''
+ !ERROR: Procedure 'p' is recursively defined. Procedures in the cycle: 'p2', 'p', 'sub'
procedure(sub) :: p
call p(sub)
@@ -21,7 +21,7 @@
end subroutine circular
program iface
- !ERROR: Procedure 'p' is recursively defined. Procedures in the cycle: ''p', 'sub', 'p2''
+ !ERROR: Procedure 'p' is recursively defined. Procedures in the cycle: 'p2', 'p', 'sub'
procedure(sub) :: p
interface
subroutine sub(p2)
@@ -38,7 +38,7 @@
Call p(sub)
contains
- !ERROR: Procedure 'sub1' is recursively defined. Procedures in the cycle: ''p', 'sub1', 'arg''
+ !ERROR: Procedure 'sub1' is recursively defined. Procedures in the cycle: 'p', 'arg', 'sub1'
Subroutine sub1(arg)
procedure(sub1) :: arg
End Subroutine
@@ -54,7 +54,7 @@
Call p(sub)
contains
- !ERROR: Procedure 'sub1' is recursively defined. Procedures in the cycle: ''p', 'sub1', 'arg', 'sub', 'p2''
+ !ERROR: Procedure 'sub1' is recursively defined. Procedures in the cycle: 'p2', 'sub', 'p', 'arg', 'sub1'
Subroutine sub1(arg)
procedure(sub) :: arg
End Subroutine
@@ -63,3 +63,24 @@
Procedure(sub1) :: p2
End Subroutine
End Program
+
+program twoCycle
+ !ERROR: The interface for procedure 'p1' is recursively defined
+ !ERROR: The interface for procedure 'p2' is recursively defined
+ procedure(p1) p2
+ procedure(p2) p1
+ call p1
+ call p2
+end program
+
+program threeCycle
+ !ERROR: The interface for procedure 'p1' is recursively defined
+ !ERROR: The interface for procedure 'p2' is recursively defined
+ procedure(p1) p2
+ !ERROR: The interface for procedure 'p3' is recursively defined
+ procedure(p2) p3
+ procedure(p3) p1
+ call p1
+ call p2
+ call p3
+end program