-
Notifications
You must be signed in to change notification settings - Fork 13.5k
[flang] PRIVATE statement in derived type applies to proc components #139336
New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
Conversation
A PRIVATE statement in a derived type definition is failing to set the default accessibility of procedure pointer components; fix. Fixes llvm#138911.
@llvm/pr-subscribers-flang-semantics Author: Peter Klausler (klausler) ChangesA 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:
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
|
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
LGTM.
It fixed our test case.
Thanks!
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
LGTM
A PRIVATE statement in a derived type definition is failing to set the default accessibility of procedure pointer components; fix.
Fixes #138911.