diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp --- a/flang/lib/Semantics/expression.cpp +++ b/flang/lib/Semantics/expression.cpp @@ -1700,10 +1700,12 @@ source = kw->v.source; symbol = kw->v.symbol; if (!symbol) { - auto componentIter{std::find_if(components.begin(), components.end(), - [=](const Symbol &symbol) { return symbol.name() == source; })}; - if (componentIter != components.end()) { - symbol = &*componentIter; + // Skip overridden inaccessible parent components in favor of + // their later overrides. + for (const Symbol &sym : components) { + if (sym.name() == source) { + symbol = &sym; + } } } if (!symbol) { // C7101 diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -5787,25 +5787,34 @@ const parser::Name &name, const Symbol *extends) { for (const Scope *scope{&currScope()}; scope;) { CHECK(scope->IsDerivedType()); - if (auto *prev{FindInScope(*scope, name)}) { - if (!context().HasError(*prev)) { - parser::MessageFixedText msg; - if (extends) { - msg = "Type cannot be extended as it has a component named" - " '%s'"_err_en_US; - } else if (prev->test(Symbol::Flag::ParentComp)) { - msg = "'%s' is a parent type of this type and so cannot be" - " a component"_err_en_US; - } else if (scope != &currScope()) { - msg = "Component '%s' is already declared in a parent of this" - " derived type"_err_en_US; - } else { - msg = "Component '%s' is already declared in this" - " derived type"_err_en_US; + if (auto *prev{FindInScope(*scope, name.source)}) { + std::optional msg; + if (context().HasError(*prev)) { // don't pile on + } else if (extends) { + msg = "Type cannot be extended as it has a component named" + " '%s'"_err_en_US; + } else if (CheckAccessibleComponent(currScope(), *prev)) { + // inaccessible component -- redeclaration is ok + msg = "Component '%s' is inaccessibly declared in or as a " + "parent of this derived type"_warn_en_US; + } else if (prev->test(Symbol::Flag::ParentComp)) { + msg = "'%s' is a parent type of this type and so cannot be" + " a component"_err_en_US; + } else if (scope == &currScope()) { + msg = "Component '%s' is already declared in this" + " derived type"_err_en_US; + } else { + msg = "Component '%s' is already declared in a parent of this" + " derived type"_err_en_US; + } + if (msg) { + Say2( + name, std::move(*msg), *prev, "Previous declaration of '%s'"_en_US); + if (msg->severity() == parser::Severity::Error) { + Resolve(name, *prev); + return false; } - Say2(name, std::move(msg), *prev, "Previous declaration of '%s'"_en_US); } - return false; } if (scope == &currScope() && extends) { // The parent component has not yet been added to the scope. diff --git a/flang/test/Semantics/symbol22.f90 b/flang/test/Semantics/symbol22.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/symbol22.f90 @@ -0,0 +1,55 @@ +! RUN: %python %S/test_symbols.py %s %flang_fc1 +! Allow redeclaration of inherited inaccessible components +!DEF: /m1 Module +module m1 + !DEF: /m1/t0 PRIVATE DerivedType + type, private :: t0 + end type + !REF: /m1/t0 + !DEF: /m1/t1 PUBLIC DerivedType + type, extends(t0) :: t1 + !DEF: /m1/t1/n1a PRIVATE ObjectEntity INTEGER(4) + !DEF: /m1/t1/n1b PRIVATE ObjectEntity INTEGER(4) + integer, private :: n1a = 1, n1b = 2 + end type +end module +!DEF: /m2 Module +module m2 + !REF: /m1 + use :: m1 + !DEF: /m2/t1 PUBLIC Use + !DEF: /m2/t2 PUBLIC DerivedType + type, extends(t1) :: t2 + !DEF: /m2/t2/t0 ObjectEntity REAL(4) + real :: t0 + !DEF: /m2/t2/n1a ObjectEntity REAL(4) + real :: n1a + end type + !REF: /m2/t2 + !DEF: /m2/t3 PUBLIC DerivedType + type, extends(t2) :: t3 + !DEF: /m2/t3/n1b ObjectEntity REAL(4) + real :: n1b + end type +end module +!DEF: /test (Subroutine) Subprogram +subroutine test + !REF: /m2 + use :: m2 + !DEF: /test/t3 Use + !DEF: /test/x ObjectEntity TYPE(t3) + type(t3) :: x + !REF: /test/x + !REF: /m2/t3/n1b + x%n1b = 1. + !REF: /test/x + !DEF: /m2/t3/t2 (ParentComp) ObjectEntity TYPE(t2) + !DEF: /test/t2 Use + x%t2 = t2(t0=2., n1a=3.) + !REF: /test/x + !REF: /m2/t2/t0 + x%t0 = 4. + !REF: /test/x + !REF: /m2/t2/n1a + x%n1a = 5. +end subroutine