[flang-commits] [flang] b670189 - [flang] Fix CheckSpecificationExpr handling of associated names
peter klausler via flang-commits
flang-commits at lists.llvm.org
Tue Nov 10 16:19:28 PST 2020
Author: peter klausler
Date: 2020-11-10T16:19:13-08:00
New Revision: b670189975f5ba4e8ef22c74724c610287b69c28
URL: https://github.com/llvm/llvm-project/commit/b670189975f5ba4e8ef22c74724c610287b69c28
DIFF: https://github.com/llvm/llvm-project/commit/b670189975f5ba4e8ef22c74724c610287b69c28.diff
LOG: [flang] Fix CheckSpecificationExpr handling of associated names
Avoid a spurious error message about a dummy procedure reference
in a specification expression by restructuring the handling of
use-associated and host-associated symbols.
Differential revision: https://reviews.llvm.org/D91209
Added:
Modified:
flang/lib/Evaluate/check-expression.cpp
flang/test/Semantics/spec-expr.f90
Removed:
################################################################################
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 @@ class CheckSpecificationExprHelper
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<semantics::ObjectEntityDetails>()) {
+ ultimate.name().ToString() + "'";
+ } else if (ultimate.has<semantics::ObjectEntityDetails>()) {
return std::nullopt;
} else {
return "dummy procedure argument";
}
- } else if (symbol.has<semantics::UseDetails>() ||
- symbol.has<semantics::HostAssocDetails>() ||
- symbol.owner().kind() == semantics::Scope::Kind::Module) {
- return std::nullopt;
} else if (const auto *object{
- symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
+ ultimate.detailsIf<semantics::ObjectEntityDetails>()}) {
// TODO: what about EQUIVALENCE with data in COMMON?
// TODO: does this work for blank COMMON?
if (object->commonBlock()) {
@@ -290,11 +289,11 @@ class CheckSpecificationExprHelper
}
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/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
More information about the flang-commits
mailing list