[flang-commits] [flang] e1ee20d - [flang] Ignore inaccessible components when extending types or constructing structures

[Peter Klausler via flang-commits]

Author: Peter Klausler
Date: 2022-08-09T07:44:02-07:00
New Revision: e1ee20d574df8ba6efb01eec3d2fa3c9cd82984d

URL: https://github.com/llvm/llvm-project/commit/e1ee20d574df8ba6efb01eec3d2fa3c9cd82984d
DIFF: https://github.com/llvm/llvm-project/commit/e1ee20d574df8ba6efb01eec3d2fa3c9cd82984d.diff

LOG: [flang] Ignore inaccessible components when extending types or constructing structures

Inaccessible components -- those declared PRIVATE in another module -- should
be allowed to be redeclared in extended types, and should be ignored if
they appear as keywords in structure constructors.

Differential Revision: https://reviews.llvm.org/D131102

Added: 
    flang/test/Semantics/symbol22.f90

Modified: 
    flang/lib/Semantics/expression.cpp
    flang/lib/Semantics/resolve-names.cpp

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 01bfea713e6a7..dacfe796f3627 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -1700,10 +1700,12 @@ MaybeExpr ExpressionAnalyzer::Analyze(
       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
index 06694efa66d9d..2c94f57a502eb 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -5787,25 +5787,34 @@ bool DeclarationVisitor::OkToAddComponent(
     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<parser::MessageFixedText> 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
index 0000000000000..6a85b37a15aea
--- /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