[flang] A TBP override may not make a public binding private

[klausler]

Summary

When a procedure binding in a derived type has PRIVATE accessibility,
it may not be an override of a type-bound procedure that is accessible.

[PeteSteinfeld]

All builds and tests correctly and looks good.

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/lib/Semantics/check-declarations.cpp

if (const auto *overriddenBinding{
             } else if (!bindingChars->CanOverride(
                            *overriddenChars, passIndex)) {
               SayWithDeclaration(*overridden,
                   "A type-bound procedure and its override must have compatible interfaces apart from their passed argument"_err_en_US);
             }
           }
         }
       }
-      if (symbol.attrs().test(Attr::PRIVATE) &&
-          overridden->attrs().test(Attr::PUBLIC)) {
+      if (symbol.attrs().test(Attr::PRIVATE)) {
+        if (FindModuleContaining(dtScope) ==
+            FindModuleContaining(overridden->owner())) {
+          // types declared in same madule
+          if (overridden->attrs().test(Attr::PUBLIC)) {
             SayWithDeclaration(*overridden,
                 "A PRIVATE procedure may not override a PUBLIC procedure"_err_en_US);
           }
+        } else { // types declared in distinct madules
+          if (!CheckAccessibleSymbol(dtScope.parent(), *overridden)) {
+            SayWithDeclaration(*overridden,
+                "A PRIVATE procedure may not override an accessible procedure"_err_en_US);
+          }
+        }
+      }
     } else {
       SayWithDeclaration(*overridden,
           "A type-bound procedure binding may not have the same name as a parent component"_err_en_US);
     }
   }
   CheckPassArg(symbol, &binding.symbol(), binding);
 }
 

flang/test/Semantics/bindings01.f90

subroutine test
     type(t) a(2)
     !PORTABILITY: Base of NOPASS type-bound procedure reference should be scalar
     call a%tbp
     !ERROR: Base of procedure component reference must be scalar
     call a%pp
   end subroutine
 end module
 
+module m9
+  type t1
+   contains
+    procedure, public :: tbp => sub1
+  end type
+  type, extends(t1) :: t2
+   contains
+    !ERROR: A PRIVATE procedure may not override a PUBLIC procedure
+    procedure, private :: tbp => sub2
+  end type
+ contains
+  subroutine sub1(x)
+    class(t1), intent(in) :: x
+  end subroutine
+  subroutine sub2(x)
+    class(t2), intent(in) :: x
+  end subroutine
+end module
+
+module m10a
+  type t1
+   contains
+    procedure :: tbp => sub1
+  end type
+ contains
+  subroutine sub1(x)
+    class(t1), intent(in) :: x
+  end subroutine
+end module
+module m10b
+  use m10a
+  type, extends(t1) :: t2
+   contains
+    !ERROR: A PRIVATE procedure may not override an accessible procedure
+    procedure, private :: tbp => sub2
+  end type
+ contains
+  subroutine sub2(x)
+    class(t2), intent(in) :: x
+  end subroutine
+end module
+
 program test
   use m1
   type,extends(t) :: t2
   end type
   type(t2) a
   call a%tbp
 end program