#include <array>
#include <list>
#include <optional>
-#include <set>
+#include <unordered_set>
#include <vector>
namespace llvm {
using SymbolVector = std::vector<SymbolRef>;
using MutableSymbolRef = common::Reference<Symbol>;
using MutableSymbolVector = std::vector<MutableSymbolRef>;
+struct SymbolHash {
+ std::size_t operator()(SymbolRef symRef) const {
+ return (std::size_t)(&symRef.get());
+ }
+};
+using SymbolSet = std::unordered_set<SymbolRef, SymbolHash>;
// A module or submodule.
class ModuleDetails {
bool operator==(const Symbol &that) const { return this == &that; }
bool operator!=(const Symbol &that) const { return !(*this == that); }
+ // For maps using symbols as keys and sorting symbols. Collate them by their
+ // position in the cooked character stream
bool operator<(const Symbol &that) const {
- // For sets of symbols: collate them by source location
- return name_.begin() < that.name_.begin();
+ return sortName_ < that.sortName_;
}
int Rank() const {
private:
const Scope *owner_;
SourceName name_;
+ const char *sortName_; // used in the "<" operator for sorting symbols
Attrs attrs_;
Flags flags_;
Scope *scope_{nullptr};
Symbol &symbol = Get();
symbol.owner_ = &owner;
symbol.name_ = name;
+ symbol.sortName_ = name.begin();
symbol.attrs_ = attrs;
symbol.details_ = std::move(details);
return symbol;
inline bool operator<(MutableSymbolRef x, MutableSymbolRef y) {
return *x < *y;
}
-using SymbolSet = std::set<SymbolRef>;
} // namespace Fortran::semantics
context().SetError(symbol);
return symbol;
}
+ bool HasCycle(const Symbol &, const ProcInterface &);
};
// Resolve construct entities and statement entities.
void ScopeHandler::ApplyImplicitRules(
Symbol &symbol, bool allowForwardReference) {
- if (!NeedsType(symbol)) {
+ if (context().HasError(symbol) || !NeedsType(symbol)) {
return;
}
if (const DeclTypeSpec * type{GetImplicitType(symbol)}) {
if (allowForwardReference && ImplicitlyTypeForwardRef(symbol)) {
return;
}
- if (!context().HasError(symbol)) {
- Say(symbol.name(), "No explicit type declared for '%s'"_err_en_US);
- context().SetError(symbol);
- }
+ Say(symbol.name(), "No explicit type declared for '%s'"_err_en_US);
+ context().SetError(symbol);
}
// Extension: Allow forward references to scalar integer dummy arguments
}
}
+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)};
"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;
}
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,
! 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
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)
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)
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: 'arg', 'p', 'sub1'
Subroutine sub1(arg)
procedure(sub1) :: arg
End Subroutine
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', 'arg', 'p', 'sub1'
Subroutine sub1(arg)
procedure(sub) :: arg
End Subroutine
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