[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.
This commit is contained in:
Peter Klausler
2025-05-12 12:28:31 -07:00
committed by GitHub
parent 0d5592713b
commit f600154ebf
4 changed files with 34 additions and 9 deletions

View File

@@ -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);

View File

@@ -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()};
}

View File

@@ -48,9 +48,9 @@ module m
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

View File

@@ -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 @@ end
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