[flang-commits] [flang] [flang] Account for accessibility in extensibility check (PR #128765)

[via flang-commits]

llvmbot wrote:


<!--LLVM PR SUMMARY COMMENT-->

@llvm/pr-subscribers-flang-semantics

Author: Peter Klausler (klausler)

<details>
<summary>Changes</summary>

A derived type with a component of the same name as the type is not extensible...  unless the extension occurs in another module where the conflicting component is inaccessible.

Fixes https://github.com/llvm/llvm-project/issues/126114.

---
Full diff: https://github.com/llvm/llvm-project/pull/128765.diff


2 Files Affected:

- (modified) flang/lib/Semantics/resolve-names.cpp (+8-5) 
- (modified) flang/test/Semantics/resolve34.f90 (+5) 


``````````diff
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 17a6665dfb6a5..a6503c7950475 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -7294,17 +7294,20 @@ bool DeclarationVisitor::OkToAddComponent(
       std::optional<parser::MessageFixedText> msg;
       std::optional<common::UsageWarning> warning;
       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 (CheckAccessibleSymbol(currScope(), *prev)) {
         // inaccessible component -- redeclaration is ok
-        if (context().ShouldWarn(
-                common::UsageWarning::RedeclaredInaccessibleComponent)) {
+        if (extends) {
+          // The parent type has a component of same name, but it remains
+          // extensible outside its module since that component is PRIVATE.
+        } else if (context().ShouldWarn(
+                       common::UsageWarning::RedeclaredInaccessibleComponent)) {
           msg =
               "Component '%s' is inaccessibly declared in or as a parent of this derived type"_warn_en_US;
           warning = common::UsageWarning::RedeclaredInaccessibleComponent;
         }
+      } else 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;
diff --git a/flang/test/Semantics/resolve34.f90 b/flang/test/Semantics/resolve34.f90
index 4ddb8fd0b0eb8..39709a362b363 100644
--- a/flang/test/Semantics/resolve34.f90
+++ b/flang/test/Semantics/resolve34.f90
@@ -45,6 +45,11 @@ module m4
   type, extends(t1) :: t2
   end type
 end
+module m4a
+  use m4
+  type, extends(t1) :: t3 ! ok, inaccessible component
+  end type
+end
 
 module m5
   type :: t1

``````````

</details>


https://github.com/llvm/llvm-project/pull/128765