Skip to content

Commit f600154

Browse files
authored
[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 #138911.
1 parent 0d55927 commit f600154

File tree

4 files changed

+34
-9
lines changed

4 files changed

+34
-9
lines changed

flang/lib/Semantics/resolve-names.cpp

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -6350,6 +6350,10 @@ void DeclarationVisitor::Post(const parser::ProcDecl &x) {
63506350
if (!dtDetails) {
63516351
attrs.set(Attr::EXTERNAL);
63526352
}
6353+
if (derivedTypeInfo_.privateComps &&
6354+
!attrs.HasAny({Attr::PUBLIC, Attr::PRIVATE})) {
6355+
attrs.set(Attr::PRIVATE);
6356+
}
63536357
Symbol &symbol{DeclareProcEntity(name, attrs, procInterface)};
63546358
SetCUDADataAttr(name.source, symbol, cudaDataAttr()); // for error
63556359
symbol.ReplaceName(name.source);

flang/lib/Semantics/tools.cpp

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1076,7 +1076,7 @@ std::optional<parser::MessageFormattedText> CheckAccessibleSymbol(
10761076
return std::nullopt;
10771077
} else {
10781078
return parser::MessageFormattedText{
1079-
"PRIVATE name '%s' is only accessible within module '%s'"_err_en_US,
1079+
"PRIVATE name '%s' is accessible only within module '%s'"_err_en_US,
10801080
symbol.name(),
10811081
DEREF(FindModuleContaining(symbol.owner())).GetName().value()};
10821082
}

flang/test/Semantics/c_loc01.f90

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -48,9 +48,9 @@ subroutine test(assumedType, poly, nclen, n)
4848
cp = c_loc(ch(1:1)) ! ok
4949
cp = c_loc(deferred) ! ok
5050
cp = c_loc(p2ch) ! ok
51-
!ERROR: PRIVATE name '__address' is only accessible within module '__fortran_builtins'
51+
!ERROR: PRIVATE name '__address' is accessible only within module '__fortran_builtins'
5252
cp = c_ptr(0)
53-
!ERROR: PRIVATE name '__address' is only accessible within module '__fortran_builtins'
53+
!ERROR: PRIVATE name '__address' is accessible only within module '__fortran_builtins'
5454
cfp = c_funptr(0)
5555
!ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types TYPE(c_ptr) and TYPE(c_funptr)
5656
cp = cfp

flang/test/Semantics/resolve34.f90

Lines changed: 27 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -90,16 +90,37 @@ module m7
9090
integer :: i2
9191
integer, private :: i3
9292
end type
93+
type :: t3
94+
private
95+
integer :: i4 = 0
96+
procedure(real), pointer, nopass :: pp1 => null()
97+
end type
98+
type, extends(t3) :: t4
99+
private
100+
integer :: i5
101+
procedure(real), pointer, nopass :: pp2
102+
end type
93103
end
94104
subroutine s7
95105
use m7
96106
type(t2) :: x
107+
type(t4) :: y
97108
integer :: j
98109
j = x%i2
99-
!ERROR: PRIVATE name 'i3' is only accessible within module 'm7'
110+
!ERROR: PRIVATE name 'i3' is accessible only within module 'm7'
100111
j = x%i3
101-
!ERROR: PRIVATE name 't1' is only accessible within module 'm7'
112+
!ERROR: PRIVATE name 't1' is accessible only within module 'm7'
102113
j = x%t1%i1
114+
!ok, parent component is not affected by PRIVATE in t4
115+
y%t3 = t3()
116+
!ERROR: PRIVATE name 'i4' is accessible only within module 'm7'
117+
y%i4 = 0
118+
!ERROR: PRIVATE name 'pp1' is accessible only within module 'm7'
119+
y%pp1 => null()
120+
!ERROR: PRIVATE name 'i5' is accessible only within module 'm7'
121+
y%i5 = 0
122+
!ERROR: PRIVATE name 'pp2' is accessible only within module 'm7'
123+
y%pp2 => null()
103124
end
104125

105126
! 7.5.4.8(2)
@@ -122,11 +143,11 @@ subroutine s1
122143
subroutine s8
123144
use m8
124145
type(t) :: x
125-
!ERROR: PRIVATE name 'i2' is only accessible within module 'm8'
146+
!ERROR: PRIVATE name 'i2' is accessible only within module 'm8'
126147
x = t(2, 5)
127-
!ERROR: PRIVATE name 'i2' is only accessible within module 'm8'
148+
!ERROR: PRIVATE name 'i2' is accessible only within module 'm8'
128149
x = t(i1=2, i2=5)
129-
!ERROR: PRIVATE name 'i2' is only accessible within module 'm8'
150+
!ERROR: PRIVATE name 'i2' is accessible only within module 'm8'
130151
a = [y%i2]
131152
end
132153

@@ -166,6 +187,6 @@ subroutine s10
166187
use m10
167188
type(t) x
168189
x = t(1)
169-
!ERROR: PRIVATE name 'operator(+)' is only accessible within module 'm10'
190+
!ERROR: PRIVATE name 'operator(+)' is accessible only within module 'm10'
170191
x = x + x
171192
end subroutine

0 commit comments

Comments
 (0)