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

[Peter Klausler via flang-commits]

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

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.

>From 0447d84aad82629b6a79a0cc41d71d4cbd941225 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Tue, 25 Feb 2025 11:36:12 -0800
Subject: [PATCH] [flang] Account for accessibility in extensibility check

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.
---
 flang/lib/Semantics/resolve-names.cpp | 13 ++++++++-----
 flang/test/Semantics/resolve34.f90    |  5 +++++
 2 files changed, 13 insertions(+), 5 deletions(-)

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