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