[flang] Extension: allow override of inaccessible DEFERRED binding

[klausler]

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.

[llvmbot]

@llvm/pr-subscribers-flang-semantics

Author: Peter Klausler (klausler)

Changes

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.

---

Full diff: https://github.com/llvm/llvm-project/pull/142691.diff

6 Files Affected:

• (modified) flang/docs/Extensions.md (+6)
• (modified) flang/include/flang/Support/Fortran-features.h (+2-1)
• (modified) flang/lib/Evaluate/tools.cpp (+2-1)
• (modified) flang/lib/Semantics/check-declarations.cpp (+6-3)
• (modified) flang/lib/Semantics/runtime-type-info.cpp (+3-1)
• (modified) flang/test/Semantics/deferred01.f90 (+4-3)

diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md
index 51969de5ac7fe..ca5e34ea610b8 100644
--- a/flang/docs/Extensions.md
+++ b/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
 
diff --git a/flang/include/flang/Support/Fortran-features.h b/flang/include/flang/Support/Fortran-features.h
index e696da9042480..79eaf56bdec11 100644
--- a/flang/include/flang/Support/Fortran-features.h
+++ b/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,
diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
index c70915cfa6150..222c32a9c332e 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/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());
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 1d09dea06db54..46a5b970fdf0c 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/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,
diff --git a/flang/lib/Semantics/runtime-type-info.cpp b/flang/lib/Semantics/runtime-type-info.cpp
index 98295f3705a71..d639904bcd724 100644
--- a/flang/lib/Semantics/runtime-type-info.cpp
+++ b/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);
diff --git a/flang/test/Semantics/deferred01.f90 b/flang/test/Semantics/deferred01.f90
index 87818c10bd399..ce406a72b8fab 100644
--- a/flang/test/Semantics/deferred01.f90
+++ b/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