[flang-commits] [flang] 4b23d4c - [flang] Extension: allow override of inaccessible DEFERRED binding (#142691)

[via flang-commits]

Author: Peter Klausler
Date: 2025-06-04T09:23:34-07:00
New Revision: 4b23d4c7ca4307f3d5c900782c78f1b66236d0c2

URL: https://github.com/llvm/llvm-project/commit/4b23d4c7ca4307f3d5c900782c78f1b66236d0c2
DIFF: https://github.com/llvm/llvm-project/commit/4b23d4c7ca4307f3d5c900782c78f1b66236d0c2.diff

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

Added: 
    

Modified: 
    flang/docs/Extensions.md
    flang/include/flang/Support/Fortran-features.h
    flang/lib/Evaluate/tools.cpp
    flang/lib/Semantics/check-declarations.cpp
    flang/lib/Semantics/runtime-type-info.cpp
    flang/test/Semantics/deferred01.f90

Removed: 
    


################################################################################
diff  --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md
index 7d5e35a3991dc..78d871c593e1d 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 378697237ba9b..ccc5e37c840a9 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