[flang] PRIVATE statement in derived type applies to proc components

[klausler]

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

Fixes #138911.

[llvmbot]

@llvm/pr-subscribers-flang-semantics

Author: Peter Klausler (klausler)

Changes

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

Fixes #138911.

---

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

4 Files Affected:

• (modified) flang/lib/Semantics/resolve-names.cpp (+4)
• (modified) flang/lib/Semantics/tools.cpp (+1-1)
• (modified) flang/test/Semantics/c_loc01.f90 (+2-2)
• (modified) flang/test/Semantics/resolve34.f90 (+27-6)

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