symbol->attrs() |= attrs;
return *symbol;
} else {
- SayAlreadyDeclared(name, *symbol);
+ if (!CheckPossibleBadForwardRef(*symbol)) {
+ SayAlreadyDeclared(name, *symbol);
+ }
// replace the old symbol with a new one with correct details
EraseSymbol(*symbol);
auto &result{MakeSymbol(name, attrs, std::move(details))};
TypeCategory, const std::optional<parser::KindSelector> &);
const DeclTypeSpec &MakeLogicalType(
const std::optional<parser::KindSelector> &);
+ void NotePossibleBadForwardRef(const parser::Name &);
+ std::optional<SourceName> HadForwardRef(const Symbol &) const;
+ bool CheckPossibleBadForwardRef(const Symbol &);
bool inExecutionPart_{false};
+ bool inSpecificationPart_{false};
+ std::set<SourceName> specPartForwardRefs_;
private:
Scope *currScope_{nullptr};
SayWithDecl(
name, symbol, "'%s' is already declared as an object"_err_en_US);
}
- } else {
+ } else if (!CheckPossibleBadForwardRef(symbol)) {
SayAlreadyDeclared(name, symbol);
}
context().SetError(symbol);
void ScopeHandler::SayAlreadyDeclared(const SourceName &name, Symbol &prev) {
if (context().HasError(prev)) {
// don't report another error about prev
- } else if (const auto *details{prev.detailsIf<UseDetails>()}) {
- Say(name, "'%s' is already declared in this scoping unit"_err_en_US)
- .Attach(details->location(),
- "It is use-associated with '%s' in module '%s'"_err_en_US,
- details->symbol().name(), GetUsedModule(*details).name());
} else {
- SayAlreadyDeclared(name, prev.name());
+ if (const auto *details{prev.detailsIf<UseDetails>()}) {
+ Say(name, "'%s' is already declared in this scoping unit"_err_en_US)
+ .Attach(details->location(),
+ "It is use-associated with '%s' in module '%s'"_err_en_US,
+ details->symbol().name(), GetUsedModule(*details).name());
+ } else {
+ SayAlreadyDeclared(name, prev.name());
+ }
+ context().SetError(prev);
}
- context().SetError(prev);
}
void ScopeHandler::SayAlreadyDeclared(
const SourceName &name1, const SourceName &name2) {
}
}
+void ScopeHandler::NotePossibleBadForwardRef(const parser::Name &name) {
+ if (inSpecificationPart_ && name.symbol) {
+ auto kind{currScope().kind()};
+ if ((kind == Scope::Kind::Subprogram && !currScope().IsStmtFunction()) ||
+ kind == Scope::Kind::Block) {
+ bool isHostAssociated{&name.symbol->owner() == &currScope()
+ ? name.symbol->has<HostAssocDetails>()
+ : name.symbol->owner().Contains(currScope())};
+ if (isHostAssociated) {
+ specPartForwardRefs_.insert(name.source);
+ }
+ }
+ }
+}
+
+std::optional<SourceName> ScopeHandler::HadForwardRef(
+ const Symbol &symbol) const {
+ auto iter{specPartForwardRefs_.find(symbol.name())};
+ if (iter != specPartForwardRefs_.end()) {
+ return *iter;
+ }
+ return std::nullopt;
+}
+
+bool ScopeHandler::CheckPossibleBadForwardRef(const Symbol &symbol) {
+ if (!context().HasError(symbol)) {
+ if (auto fwdRef{HadForwardRef(symbol)}) {
+ Say(*fwdRef,
+ "Forward reference to '%s' is not allowed in the same specification part"_err_en_US,
+ *fwdRef)
+ .Attach(symbol.name(), "Later declaration of '%s'"_en_US, *fwdRef);
+ context().SetError(symbol);
+ return true;
+ }
+ }
+ return false;
+}
+
void ScopeHandler::MakeExternal(Symbol &symbol) {
if (!symbol.attrs().test(Attr::EXTERNAL)) {
symbol.attrs().set(Attr::EXTERNAL);
symbol.SetType(type);
} else if (symbol.has<UseDetails>()) {
// error recovery case, redeclaration of use-associated name
+ } else if (HadForwardRef(symbol)) {
+ // error recovery after use of host-associated name
} else if (!symbol.test(Symbol::Flag::Implicit)) {
SayWithDecl(
name, symbol, "The type of '%s' has already been declared"_err_en_US);
const parser::Name *DeclarationVisitor::ResolveName(const parser::Name &name) {
FindSymbol(name);
if (CheckForHostAssociatedImplicit(name)) {
+ NotePossibleBadForwardRef(name);
return &name;
}
if (Symbol * symbol{name.symbol}) {
if (CheckUseError(name)) {
return nullptr; // reported an error
}
+ NotePossibleBadForwardRef(name);
symbol->set(Symbol::Flag::ImplicitOrError, false);
if (IsUplevelReference(*symbol)) {
MakeHostAssocSymbol(name, *symbol);
}
ConvertToObjectEntity(*symbol);
ApplyImplicitRules(*symbol);
+ NotePossibleBadForwardRef(name);
return &name;
}
Scope *host{GetHostProcedure()};
if (!host || isImplicitNoneType(*host)) {
return false;
- } else if (!name.symbol) {
+ }
+ if (!name.symbol) {
hostSymbol = &MakeSymbol(*host, name.source, Attrs{});
ConvertToObjectEntity(*hostSymbol);
ApplyImplicitRules(*hostSymbol);
bool ResolveNamesVisitor::Pre(const parser::SpecificationPart &x) {
const auto &[accDecls, ompDecls, compilerDirectives, useStmts, importStmts,
implicitPart, decls] = x.t;
+ auto flagRestorer{common::ScopedSet(inSpecificationPart_, true)};
Walk(accDecls);
Walk(ompDecls);
Walk(compilerDirectives);
Walk(useStmts);
Walk(importStmts);
Walk(implicitPart);
+ auto setRestorer{
+ common::ScopedSet(specPartForwardRefs_, std::set<SourceName>{})};
for (const auto &decl : decls) {
if (const auto *spec{
std::get_if<parser::SpecificationConstruct>(&decl.u)}) {
symbol.set(
symbol.GetType() ? Symbol::Flag::Function : Symbol::Flag::Subroutine);
}
+ if (!symbol.has<HostAssocDetails>()) {
+ CheckPossibleBadForwardRef(symbol);
+ }
}
currScope().InstantiateDerivedTypes(context());
for (const auto &decl : decls) {
--- /dev/null
+! RUN: %S/test_errors.sh %s %t %f18
+
+! Check errors from illegal (10.1.12 para 2) forward references
+! in specification expressions to entities declared later in the
+! same specification part.
+
+module m1
+ integer :: m1j1, m1j2, m1j3, m1j4
+ contains
+ subroutine s1
+ !ERROR: Forward reference to 'm1j1' is not allowed in the same specification part
+ integer(kind=kind(m1j1)) :: t_s1m1j1
+ integer(kind=kind(m1s1j1)) :: t_s1j1 ! implicitly typed in s1
+ integer :: m1j1, m1s1j1, m1s1j2, m1s1j4
+ block
+ !ERROR: Forward reference to 'm1j2' is not allowed in the same specification part
+ integer(kind=kind(m1j2)) :: t_s1bm1j2
+ !ERROR: Forward reference to 'm1s1j2' is not allowed in the same specification part
+ integer(kind=kind(m1s1j2)) :: t_s1bm1s1j2
+ !ERROR: Forward reference to 'm1s1j3' is not allowed in the same specification part
+ integer(kind=kind(m1s1j3)) :: t_m1s1j3 ! m1s1j3 implicitly typed in s1
+ integer :: m1j2, m1s1j2, m1s1j3
+ end block
+ contains
+ subroutine s2
+ !ERROR: Forward reference to 'm1j3' is not allowed in the same specification part
+ integer(kind=kind(m1j3)) :: t_m1j3
+ !ERROR: Forward reference to 'm1s1j3' is not allowed in the same specification part
+ integer(kind=kind(m1s1j3)) :: t_m1s1j3
+ integer :: m1j3, m1s1j3, m1s2j1
+ block
+ !ERROR: Forward reference to 'm1j4' is not allowed in the same specification part
+ integer(kind=kind(m1j4)) :: t_m1j4
+ !ERROR: Forward reference to 'm1s1j4' is not allowed in the same specification part
+ integer(kind=kind(m1s1j4)) :: t_m1s1j4
+ !ERROR: Forward reference to 'm1s2j1' is not allowed in the same specification part
+ integer(kind=kind(m1s2j1)) :: t_m1s2j1
+ !ERROR: Forward reference to 'm1s2j2' is not allowed in the same specification part
+ integer(kind=kind(m1s2j2)) :: t_m1s2j2 ! m1s2j2 implicitly typed in s2
+ integer :: m1j4, m1s1j4, m1s2j1, m1s2j2
+ end block
+ end subroutine
+ end subroutine
+end module
+
+module m2
+ implicit none
+ integer :: m2j1, m2j2, m2j3, m2j4
+ contains
+ subroutine s1
+ !ERROR: Forward reference to 'm2j1' is not allowed in the same specification part
+ integer(kind=kind(m2j1)) :: t_s1m2j1
+ !ERROR: No explicit type declared for 'm2s1j1'
+ integer(kind=kind(m2s1j1)) :: t_s1j1
+ integer :: m2j1, m2s1j1, m2s1j2, m2s1j4
+ block
+ !ERROR: Forward reference to 'm2j2' is not allowed in the same specification part
+ integer(kind=kind(m2j2)) :: t_s1bm2j2
+ !ERROR: Forward reference to 'm2s1j2' is not allowed in the same specification part
+ integer(kind=kind(m2s1j2)) :: t_s1bm2s1j2
+ !ERROR: No explicit type declared for 'm2s1j3'
+ integer(kind=kind(m2s1j3)) :: t_m2s1j3
+ integer :: m2j2, m2s1j2, m2s1j3
+ end block
+ contains
+ subroutine s2
+ !ERROR: Forward reference to 'm2j3' is not allowed in the same specification part
+ integer(kind=kind(m2j3)) :: t_m2j3
+ !ERROR: No explicit type declared for 'm2s1j3'
+ integer(kind=kind(m2s1j3)) :: t_m2s1j3
+ integer :: m2j3, m2s1j3, m2s2j1
+ block
+ !ERROR: Forward reference to 'm2j4' is not allowed in the same specification part
+ integer(kind=kind(m2j4)) :: t_m2j4
+ !ERROR: Forward reference to 'm2s1j4' is not allowed in the same specification part
+ integer(kind=kind(m2s1j4)) :: t_m2s1j4
+ !ERROR: Forward reference to 'm2s2j1' is not allowed in the same specification part
+ integer(kind=kind(m2s2j1)) :: t_m2s2j1
+ !ERROR: No explicit type declared for 'm2s2j2'
+ integer(kind=kind(m2s2j2)) :: t_m2s2j2
+ integer :: m2j4, m2s1j4, m2s2j1, m2s2j2
+ end block
+ end subroutine
+ end subroutine
+end module
+
+! Case that elicited bad errors
+SUBROUTINE KEEL
+ INTEGER NODES
+ CONTAINS
+ SUBROUTINE SGEOM
+ REAL :: RADIUS(nodes)
+ END SUBROUTINE
+END SUBROUTINE KEEL