diff --git a/flang/include/flang/Semantics/scope.h b/flang/include/flang/Semantics/scope.h index fd2198b2ae61..a69263b44e6a 100644 --- a/flang/include/flang/Semantics/scope.h +++ b/flang/include/flang/Semantics/scope.h @@ -84,8 +84,13 @@ public: } Kind kind() const { return kind_; } bool IsGlobal() const { return kind_ == Kind::Global; } - bool IsModule() const; // only module, not submodule - bool IsSubmodule() const; + bool IsModule() const { + return kind_ == Kind::Module && + !symbol_->get().isSubmodule(); + } + bool IsSubmodule() const { + return kind_ == Kind::Module && symbol_->get().isSubmodule(); + } bool IsDerivedType() const { return kind_ == Kind::DerivedType; } bool IsStmtFunction() const; bool IsParameterizedDerivedType() const; diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp index f4348c5108b5..57e20165a99c 100644 --- a/flang/lib/Evaluate/check-expression.cpp +++ b/flang/lib/Evaluate/check-expression.cpp @@ -258,30 +258,29 @@ public: Result operator()(const CoarrayRef &) const { return "coindexed reference"; } Result operator()(const semantics::Symbol &symbol) const { - if (semantics::IsNamedConstant(symbol)) { + const auto &ultimate{symbol.GetUltimate()}; + if (semantics::IsNamedConstant(ultimate) || ultimate.owner().IsModule() || + ultimate.owner().IsSubmodule()) { return std::nullopt; - } else if (scope_.IsDerivedType() && IsVariableName(symbol)) { // C750, C754 + } else if (scope_.IsDerivedType() && + IsVariableName(ultimate)) { // C750, C754 return "derived type component or type parameter value not allowed to " "reference variable '"s + - symbol.name().ToString() + "'"; - } else if (IsDummy(symbol)) { - if (symbol.attrs().test(semantics::Attr::OPTIONAL)) { + ultimate.name().ToString() + "'"; + } else if (IsDummy(ultimate)) { + if (ultimate.attrs().test(semantics::Attr::OPTIONAL)) { return "reference to OPTIONAL dummy argument '"s + - symbol.name().ToString() + "'"; - } else if (symbol.attrs().test(semantics::Attr::INTENT_OUT)) { + ultimate.name().ToString() + "'"; + } else if (ultimate.attrs().test(semantics::Attr::INTENT_OUT)) { return "reference to INTENT(OUT) dummy argument '"s + - symbol.name().ToString() + "'"; - } else if (symbol.has()) { + ultimate.name().ToString() + "'"; + } else if (ultimate.has()) { return std::nullopt; } else { return "dummy procedure argument"; } - } else if (symbol.has() || - symbol.has() || - symbol.owner().kind() == semantics::Scope::Kind::Module) { - return std::nullopt; } else if (const auto *object{ - symbol.detailsIf()}) { + ultimate.detailsIf()}) { // TODO: what about EQUIVALENCE with data in COMMON? // TODO: does this work for blank COMMON? if (object->commonBlock()) { @@ -290,11 +289,11 @@ public: } for (const semantics::Scope *s{&scope_}; !s->IsGlobal();) { s = &s->parent(); - if (s == &symbol.owner()) { + if (s == &ultimate.owner()) { return std::nullopt; } } - return "reference to local entity '"s + symbol.name().ToString() + "'"; + return "reference to local entity '"s + ultimate.name().ToString() + "'"; } Result operator()(const Component &x) const { diff --git a/flang/lib/Semantics/scope.cpp b/flang/lib/Semantics/scope.cpp index 768f9f5aab1b..7beb4e33a7d8 100644 --- a/flang/lib/Semantics/scope.cpp +++ b/flang/lib/Semantics/scope.cpp @@ -49,13 +49,6 @@ std::string EquivalenceObject::AsFortran() const { return ss.str(); } -bool Scope::IsModule() const { - return kind_ == Kind::Module && !symbol_->get().isSubmodule(); -} -bool Scope::IsSubmodule() const { - return kind_ == Kind::Module && symbol_->get().isSubmodule(); -} - Scope &Scope::MakeScope(Kind kind, Symbol *symbol) { return children_.emplace_back(*this, kind, symbol); } diff --git a/flang/test/Semantics/spec-expr.f90 b/flang/test/Semantics/spec-expr.f90 index df856b3bd8dc..c02cabc04895 100644 --- a/flang/test/Semantics/spec-expr.f90 +++ b/flang/test/Semantics/spec-expr.f90 @@ -173,3 +173,12 @@ subroutine s15() real, dimension((param + 2)) :: realField end type dtype end subroutine s15 + +! Regression test: don't get confused by host association +subroutine s16(n) + integer :: n + contains + subroutine inner(r) + real, dimension(n) :: r + end subroutine +end subroutine s16