From 2e0873c75ef8016a10e2052a1ce21e4fa5974cf3 Mon Sep 17 00:00:00 2001 From: Peter Klausler Date: Wed, 15 Mar 2023 13:06:20 -0700 Subject: [PATCH] [flang] Fix check for PRIVATE override of PUBLIC t.b.p. A PRIVATE procedure binding in a derived type extension may not be an override of a PUBLIC procedure binding. Declaration checking for this case was working only in the presence of an explicit PUBLIC accessibility attribute, when it should be checking for the absence of a PRIVATE accessibility attribute. Differential Revision: https://reviews.llvm.org/D146577 --- flang/lib/Semantics/check-declarations.cpp | 2 +- flang/test/Semantics/bindings01.f90 | 18 ++++++++++++++++++ 2 files changed, 19 insertions(+), 1 deletion(-) diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp index 45a6266..ee6853f 100644 --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -1983,7 +1983,7 @@ void CheckHelper::CheckProcBinding( if (FindModuleContaining(dtScope) == FindModuleContaining(overridden->owner())) { // types declared in same madule - if (overridden->attrs().test(Attr::PUBLIC)) { + if (!overridden->attrs().test(Attr::PRIVATE)) { SayWithDeclaration(*overridden, "A PRIVATE procedure may not override a PUBLIC procedure"_err_en_US); } diff --git a/flang/test/Semantics/bindings01.f90 b/flang/test/Semantics/bindings01.f90 index 12e31df..024c392 100644 --- a/flang/test/Semantics/bindings01.f90 +++ b/flang/test/Semantics/bindings01.f90 @@ -275,6 +275,24 @@ module m10b end subroutine end module +module m11 + type t1 + contains + procedure, nopass :: tbp => t1p + end type + type, extends(t1) :: t2 + contains + private + !ERROR: A PRIVATE procedure may not override a PUBLIC procedure + procedure, nopass :: tbp => t2p + end type + contains + subroutine t1p + end + subroutine t2p + end +end + program test use m1 type,extends(t) :: t2 -- 2.7.4