[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.
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index b297969..bdafc03 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -6350,6 +6350,10 @@
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 08d2605..1d1e3ac 100644
--- a/flang/lib/Semantics/tools.cpp
+++ b/flang/lib/Semantics/tools.cpp
@@ -1076,7 +1076,7 @@
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 abae1e2..a515a7a 100644
--- a/flang/test/Semantics/c_loc01.f90
+++ b/flang/test/Semantics/c_loc01.f90
@@ -48,9 +48,9 @@
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 39709a3..da1b80b 100644
--- a/flang/test/Semantics/resolve34.f90
+++ b/flang/test/Semantics/resolve34.f90
@@ -90,16 +90,37 @@
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 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 @@
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