[flang] Extension: allow override of inaccessible DEFERRED binding

flang/docs/Extensions.md

@@ -164,6 +164,12 @@ end
   No other Fortran compiler enforces C7108 (to our knowledge);
   they all resolve the ambiguity by interpreting the call as a function
   reference.  We do the same, with a portability warning.
+* An override for an inaccessible procedure binding works only within
+  the same module; other apparent overrides of inaccessible bindings
+  are actually new bindings of the same name.
+  In the case of `DEFERRED` bindings in an `ABSTRACT` derived type,
+  however, overrides are necessary, so they are permitted for inaccessible
+  bindings with an optional warning.
 
 ## Extensions, deletions, and legacy features supported by default
 

flang/include/flang/Support/Fortran-features.h

@@ -55,7 +55,8 @@ ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines,
     UndefinableAsynchronousOrVolatileActual, AutomaticInMainProgram, PrintCptr,
     SavedLocalInSpecExpr, PrintNamelist, AssumedRankPassedToNonAssumedRank,
     IgnoreIrrelevantAttributes, Unsigned, AmbiguousStructureConstructor,
-    ContiguousOkForSeqAssociation, ForwardRefExplicitTypeDummy)
+    ContiguousOkForSeqAssociation, ForwardRefExplicitTypeDummy,
+    InaccessibleDeferredOverride)
 
 // Portability and suspicious usage warnings
 ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable,

flang/lib/Evaluate/tools.cpp

@@ -1206,7 +1206,8 @@ parser::Message *AttachDeclaration(
   }
   if (const auto *binding{
           unhosted->detailsIf<semantics::ProcBindingDetails>()}) {
-    if (binding->symbol().name() != symbol.name()) {
+    if (!symbol.attrs().test(semantics::Attr::DEFERRED) &&
+        binding->symbol().name() != symbol.name()) {
       message.Attach(binding->symbol().name(),
           "Procedure '%s' of type '%s' is bound to '%s'"_en_US, symbol.name(),
           symbol.owner().GetName().value(), binding->symbol().name());

flang/lib/Semantics/check-declarations.cpp

@@ -2586,9 +2586,12 @@ void CheckHelper::CheckProcBinding(
   }
   if (overridden) {
     if (isInaccessibleDeferred) {
-      SayWithDeclaration(*overridden,
-          "Override of PRIVATE DEFERRED '%s' must appear in its module"_err_en_US,
-          symbol.name());
+      evaluate::AttachDeclaration(
+          Warn(common::LanguageFeature::InaccessibleDeferredOverride,
+              symbol.name(),
+              "Override of PRIVATE DEFERRED '%s' should appear in its module"_warn_en_US,
+              symbol.name()),
+          *overridden);
     }
     if (overridden->attrs().test(Attr::NON_OVERRIDABLE)) {
       SayWithDeclaration(*overridden,

flang/lib/Semantics/runtime-type-info.cpp

@@ -1018,9 +1018,11 @@ SymbolVector CollectBindings(const Scope &dtScope) {
       if (overriderIter != localBindings.end()) {
         Symbol &overrider{*overriderIter->second};
         if (symbol.attrs().test(Attr::PRIVATE) &&
+            !symbol.attrs().test(Attr::DEFERRED) &&
             FindModuleContaining(symbol.owner()) !=
                 FindModuleContaining(dtScope)) {
-          // Don't override inaccessible PRIVATE bindings
+          // Don't override inaccessible PRIVATE bindings, unless
+          // they are deferred
           auto &binding{overrider.get<ProcBindingDetails>()};
           binding.set_numPrivatesNotOverridden(
               binding.numPrivatesNotOverridden() + 1);

flang/test/Semantics/deferred01.f90

@@ -1,6 +1,7 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic -Werror
 ! Deferred TBPs must be overridden, but when they are private, those
-! overrides must appear in the same module.
+! overrides are required to appear in the same module.  We allow overrides
+! elsewhere as an extension.
 module m1
   type, abstract :: absBase
    contains
@@ -18,7 +19,7 @@ module m2
   use m1
   type, extends(absBase) :: ext
    contains
-    !ERROR: Override of PRIVATE DEFERRED 'deferredtbp' must appear in its module
+    !WARNING: Override of PRIVATE DEFERRED 'deferredtbp' should appear in its module
     procedure :: deferredTbp => implTbp
   end type
  contains