[flang-commits] [flang] [flang] Correct accessibility of name that is both generic and derive… (PR #85098)

[Peter Klausler via flang-commits]

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

…d type

When the same name is used for a derived type and generic interface in a module, and no explicit PUBLIC or PRIVATE statement appears for the name but the derived type definition does have an explicit accessibility, that accessibility must also apply to the generic interface.

>From 244809b8221357f80aead8c142d71a26451158e3 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Wed, 13 Mar 2024 08:33:56 -0700
Subject: [PATCH] [flang] Correct accessibility of name that is both generic
 and derived type

When the same name is used for a derived type and generic interface
in a module, and no explicit PUBLIC or PRIVATE statement appears for
the name but the derived type definition does have an explicit
accessibility, that accessibility must also apply to the generic
interface.
---
 flang/lib/Semantics/resolve-names.cpp | 19 +++++++++++---
 flang/test/Semantics/resolve11.f90    | 37 +++++++++++++++++++++++++++
 2 files changed, 53 insertions(+), 3 deletions(-)

diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 67392a02cf1862..b13674573fe07e 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -3391,12 +3391,25 @@ void ModuleVisitor::ApplyDefaultAccess() {
   const auto *moduleDetails{
       DEREF(currScope().symbol()).detailsIf<ModuleDetails>()};
   CHECK(moduleDetails);
+  Attr defaultAttr{
+      DEREF(moduleDetails).isDefaultPrivate() ? Attr::PRIVATE : Attr::PUBLIC};
   for (auto &pair : currScope()) {
     Symbol &symbol{*pair.second};
     if (!symbol.attrs().HasAny({Attr::PUBLIC, Attr::PRIVATE})) {
-      SetImplicitAttr(symbol,
-          DEREF(moduleDetails).isDefaultPrivate() ? Attr::PRIVATE
-                                                  : Attr::PUBLIC);
+      Attr attr{defaultAttr};
+      if (auto *generic{symbol.detailsIf<GenericDetails>()}) {
+        if (generic->derivedType()) {
+          // If a generic interface has a derived type of the same
+          // name that has an explicit accessibility attribute, then
+          // the generic must have the same accessibility.
+          if (generic->derivedType()->attrs().test(Attr::PUBLIC)) {
+            attr = Attr::PUBLIC;
+          } else if (generic->derivedType()->attrs().test(Attr::PRIVATE)) {
+            attr = Attr::PRIVATE;
+          }
+        }
+      }
+      SetImplicitAttr(symbol, attr);
     }
   }
 }
diff --git a/flang/test/Semantics/resolve11.f90 b/flang/test/Semantics/resolve11.f90
index 33ce88342b49be..db508f062d1d1c 100644
--- a/flang/test/Semantics/resolve11.f90
+++ b/flang/test/Semantics/resolve11.f90
@@ -49,3 +49,40 @@ logical function gt(x, y)
   !ERROR: The accessibility of 'OPERATOR(.GT.)' has already been specified as PUBLIC
   private :: operator(.gt.)
 end
+
+module m4
+  private
+  type, public :: foo
+  end type
+  interface foo
+    procedure fun
+  end interface
+ contains
+  function fun
+  end
+end
+
+subroutine s4
+  !ERROR: 'fun' is PRIVATE in 'm4'
+  use m4, only: foo, fun
+  type(foo) x ! ok
+  print *, foo() ! ok
+end
+
+module m5
+  public
+  type, private :: foo
+  end type
+  interface foo
+    procedure fun
+  end interface
+ contains
+  function fun
+  end
+end
+
+subroutine s5
+  !ERROR: 'foo' is PRIVATE in 'm5'
+  use m5, only: foo, fun
+  print *, fun() ! ok
+end