#include <array>
#include <list>
#include <optional>
-#include <unordered_set>
+#include <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 {
- return sortName_ < that.sortName_;
+ // For sets of symbols: collate them by source location
+ return name_.begin() < that.name_.begin();
}
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 (context().HasError(symbol) || !NeedsType(symbol)) {
+ if (!NeedsType(symbol)) {
return;
}
if (const DeclTypeSpec * type{GetImplicitType(symbol)}) {
if (allowForwardReference && ImplicitlyTypeForwardRef(symbol)) {
return;
}
- Say(symbol.name(), "No explicit type declared for '%s'"_err_en_US);
- context().SetError(symbol);
+ if (!context().HasError(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 (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)) {
+ } else {
+ if (interface.type()) {
symbol.set(Symbol::Flag::Function);
- } else if (interface.symbol()->test(Symbol::Flag::Subroutine)) {
- symbol.set(Symbol::Flag::Subroutine);
+ } 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);
+ }
}
+ 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 (!context().HasError(*symbol) && !symbol->HasExplicitInterface()) {
+ if (!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: 'p2', 'sub'
+!ERROR: Procedure 'sub' is recursively defined. Procedures in the cycle: ''sub', 'p2''
subroutine sub(p2)
PROCEDURE(sub) :: p2
end subroutine
subroutine circular
- !ERROR: Procedure 'p' is recursively defined. Procedures in the cycle: 'p2', 'p', 'sub'
+ !ERROR: Procedure 'p' is recursively defined. Procedures in the cycle: ''p', 'sub', 'p2''
procedure(sub) :: p
call p(sub)
end subroutine circular
program iface
- !ERROR: Procedure 'p' is recursively defined. Procedures in the cycle: 'p2', 'p', 'sub'
+ !ERROR: Procedure 'p' is recursively defined. Procedures in the cycle: ''p', 'sub', 'p2''
procedure(sub) :: p
interface
subroutine sub(p2)
Call p(sub)
contains
- !ERROR: Procedure 'sub1' is recursively defined. Procedures in the cycle: 'arg', 'p', 'sub1'
+ !ERROR: Procedure 'sub1' is recursively defined. Procedures in the cycle: ''p', 'sub1', 'arg''
Subroutine sub1(arg)
procedure(sub1) :: arg
End Subroutine
Call p(sub)
contains
- !ERROR: Procedure 'sub1' is recursively defined. Procedures in the cycle: 'p2', 'sub', 'arg', 'p', 'sub1'
+ !ERROR: Procedure 'sub1' is recursively defined. Procedures in the cycle: ''p', 'sub1', 'arg', 'sub', 'p2''
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