[flang-commits] [flang] f600154 - [flang] PRIVATE statement in derived type applies to proc components (#139336)

[via flang-commits]

Author: Peter Klausler
Date: 2025-05-12T12:28:31-07:00
New Revision: f600154ebf3b947e6ae1e5ab307dfaa4a9e2f78a

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

LOG: [flang] PRIVATE statement in derived type applies to proc components (#139336)

A PRIVATE statement in a derived type definition is failing to set the
default accessibility of procedure pointer components; fix.

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

Added: 
    

Modified: 
    flang/lib/Semantics/resolve-names.cpp
    flang/lib/Semantics/tools.cpp
    flang/test/Semantics/c_loc01.f90
    flang/test/Semantics/resolve34.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index b2979690f78e7..bdafc03ad2c05 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -6350,6 +6350,10 @@ void DeclarationVisitor::Post(const parser::ProcDecl &x) {
   if (!dtDetails) {
     attrs.set(Attr::EXTERNAL);
   }
+  if (derivedTypeInfo_.privateComps &&
+      !attrs.HasAny({Attr::PUBLIC, Attr::PRIVATE})) {
+    attrs.set(Attr::PRIVATE);
+  }
   Symbol &symbol{DeclareProcEntity(name, attrs, procInterface)};
   SetCUDADataAttr(name.source, symbol, cudaDataAttr()); // for error
   symbol.ReplaceName(name.source);

diff  --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp
index 08d260555f37e..1d1e3ac044166 100644
--- a/flang/lib/Semantics/tools.cpp
+++ b/flang/lib/Semantics/tools.cpp
@@ -1076,7 +1076,7 @@ std::optional<parser::MessageFormattedText> CheckAccessibleSymbol(
     return std::nullopt;
   } else {
     return parser::MessageFormattedText{
-        "PRIVATE name '%s' is only accessible within module '%s'"_err_en_US,
+        "PRIVATE name '%s' is accessible only within module '%s'"_err_en_US,
         symbol.name(),
         DEREF(FindModuleContaining(symbol.owner())).GetName().value()};
   }

diff  --git a/flang/test/Semantics/c_loc01.f90 b/flang/test/Semantics/c_loc01.f90
index abae1e263e2e2..a515a7a64f02a 100644
--- a/flang/test/Semantics/c_loc01.f90
+++ b/flang/test/Semantics/c_loc01.f90
@@ -48,9 +48,9 @@ subroutine test(assumedType, poly, nclen, n)
     cp = c_loc(ch(1:1)) ! ok
     cp = c_loc(deferred) ! ok
     cp = c_loc(p2ch) ! ok
-    !ERROR: PRIVATE name '__address' is only accessible within module '__fortran_builtins'
+    !ERROR: PRIVATE name '__address' is accessible only within module '__fortran_builtins'
     cp = c_ptr(0)
-    !ERROR: PRIVATE name '__address' is only accessible within module '__fortran_builtins'
+    !ERROR: PRIVATE name '__address' is accessible only within module '__fortran_builtins'
     cfp = c_funptr(0)
     !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types TYPE(c_ptr) and TYPE(c_funptr)
     cp = cfp

diff  --git a/flang/test/Semantics/resolve34.f90 b/flang/test/Semantics/resolve34.f90
index 39709a362b363..da1b80b5a50b0 100644
--- a/flang/test/Semantics/resolve34.f90
+++ b/flang/test/Semantics/resolve34.f90
@@ -90,16 +90,37 @@ module m7
     integer :: i2
     integer, private :: i3
   end type
+  type :: t3
+    private
+    integer :: i4 = 0
+    procedure(real), pointer, nopass :: pp1 => null()
+  end type
+  type, extends(t3) :: t4
+    private
+    integer :: i5
+    procedure(real), pointer, nopass :: pp2
+  end type
 end
 subroutine s7
   use m7
   type(t2) :: x
+  type(t4) :: y
   integer :: j
   j = x%i2
-  !ERROR: PRIVATE name 'i3' is only accessible within module 'm7'
+  !ERROR: PRIVATE name 'i3' is accessible only within module 'm7'
   j = x%i3
-  !ERROR: PRIVATE name 't1' is only accessible within module 'm7'
+  !ERROR: PRIVATE name 't1' is accessible only within module 'm7'
   j = x%t1%i1
+  !ok, parent component is not affected by PRIVATE in t4
+  y%t3 = t3()
+  !ERROR: PRIVATE name 'i4' is accessible only within module 'm7'
+  y%i4 = 0
+  !ERROR: PRIVATE name 'pp1' is accessible only within module 'm7'
+  y%pp1 => null()
+  !ERROR: PRIVATE name 'i5' is accessible only within module 'm7'
+  y%i5 = 0
+  !ERROR: PRIVATE name 'pp2' is accessible only within module 'm7'
+  y%pp2 => null()
 end
 
 ! 7.5.4.8(2)
@@ -122,11 +143,11 @@ subroutine s1
 subroutine s8
   use m8
   type(t) :: x
-  !ERROR: PRIVATE name 'i2' is only accessible within module 'm8'
+  !ERROR: PRIVATE name 'i2' is accessible only within module 'm8'
   x = t(2, 5)
-  !ERROR: PRIVATE name 'i2' is only accessible within module 'm8'
+  !ERROR: PRIVATE name 'i2' is accessible only within module 'm8'
   x = t(i1=2, i2=5)
-  !ERROR: PRIVATE name 'i2' is only accessible within module 'm8'
+  !ERROR: PRIVATE name 'i2' is accessible only within module 'm8'
   a = [y%i2]
 end
 
@@ -166,6 +187,6 @@ subroutine s10
   use m10
   type(t) x
   x = t(1)
-  !ERROR: PRIVATE name 'operator(+)' is only accessible within module 'm10'
+  !ERROR: PRIVATE name 'operator(+)' is accessible only within module 'm10'
   x = x + x
 end subroutine