[flang] Extension: allow override of inaccessible DEFERRED binding (#142691)

Inaccessible procedure bindings can't be overridden, but DEFERRED
bindings must be in a non-abstract extension. We presently emit an error
for an attempt to override an inaccessible binding in this case. But
some compilers accept this usage, and since it seems safe enough, I'll
allow it with an optional warning. Codes can avoid this warning and
conform to the standard by changing the deferred bindings to be public.

Author: klausler

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