[flang-commits] [flang] 2e0873c - [flang] Fix check for PRIVATE override of PUBLIC t.b.p.

[Peter Klausler via flang-commits]

Author: Peter Klausler
Date: 2023-03-27T15:43:43-07:00
New Revision: 2e0873c75ef8016a10e2052a1ce21e4fa5974cf3

URL: https://github.com/llvm/llvm-project/commit/2e0873c75ef8016a10e2052a1ce21e4fa5974cf3
DIFF: https://github.com/llvm/llvm-project/commit/2e0873c75ef8016a10e2052a1ce21e4fa5974cf3.diff

LOG: [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

Added: 
    

Modified: 
    flang/lib/Semantics/check-declarations.cpp
    flang/test/Semantics/bindings01.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 45a626640036..ee6853fdeb43 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 12e31dfc994c..024c3921198d 100644
--- a/flang/test/Semantics/bindings01.f90
+++ b/flang/test/Semantics/bindings01.f90
@@ -275,6 +275,24 @@ subroutine sub2(x)
   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