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

[via flang-commits]

Author: Peter Klausler
Date: 2024-03-13T15:13:56-07:00
New Revision: 702a86a8f1e4d96c62574fc8d7dd9ccea243517a

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

LOG: [flang] Correct accessibility of name that is both generic and derive… (#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.

Added: 
    

Modified: 
    flang/lib/Semantics/resolve-names.cpp
    flang/test/Semantics/resolve11.f90

Removed: 
    


################################################################################
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