[flang-commits] [flang] fee041f - [flang] Document and warn about an extension

[Peter Klausler via flang-commits]

Author: Peter Klausler
Date: 2022-12-03T11:09:59-08:00
New Revision: fee041f69de071cf813c332abc8be279ff7c0bb7

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

LOG: [flang] Document and warn about an extension

Standard Fortran allows type-bound procedure bindings to only
be called, and disallows them from being used in other contexts
where a procedure name can be: as the target of a procedure pointer
assignment statement, and as an actual argument that corresponds
to a dummy procedure.  So long as the interfaces match, there's
no good reason for these uses to be errors, and there some obvious
use cases in polymorphic programming.  So emit portability warnings
rather than errors, and document this usage as an extension.

Differential Revision: https://reviews.llvm.org/D139127

Added: 
    flang/test/Semantics/bindings03.f90

Modified: 
    flang/docs/Extensions.md
    flang/lib/Semantics/check-call.cpp
    flang/lib/Semantics/pointer-assignment.cpp

Removed: 
    


################################################################################
diff  --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md
index e56585e60149..eea4249e9034 100644
--- a/flang/docs/Extensions.md
+++ b/flang/docs/Extensions.md
@@ -247,6 +247,9 @@ end
   if a binding has renaming with "=> proc".
   The colons are not necessary for an unambiguous parse, C768
   notwithstanding.
+* A type-bound procedure binding can be passed as an actual
+  argument corresponding to a dummy procedure and can be used as
+  the target of a procedure pointer assignment statement.
 
 ### Extensions supported when enabled by options
 

diff  --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index 773d0ebb740b..5c12cea565d7 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -599,6 +599,10 @@ static void CheckProcedureArg(evaluate::ActualArgument &arg,
               argProcSymbol->name());
           return;
         }
+      } else if (argProcSymbol->has<ProcBindingDetails>()) {
+        evaluate::SayWithDeclaration(messages, *argProcSymbol,
+            "Procedure binding '%s' passed as an actual argument"_port_en_US,
+            argProcSymbol->name());
       }
     }
     if (auto argChars{characteristics::DummyArgument::FromActual(

diff  --git a/flang/lib/Semantics/pointer-assignment.cpp b/flang/lib/Semantics/pointer-assignment.cpp
index 9ac18b0d2c5b..a2e34970c196 100644
--- a/flang/lib/Semantics/pointer-assignment.cpp
+++ b/flang/lib/Semantics/pointer-assignment.cpp
@@ -307,6 +307,10 @@ bool PointerAssignmentChecker::Check(const evaluate::ProcedureDesignator &d) {
             symbol->name());
         return false;
       }
+    } else if (symbol->has<ProcBindingDetails>()) {
+      evaluate::SayWithDeclaration(context_.messages(), *symbol,
+          "Procedure binding '%s' used as target of a pointer assignment"_port_en_US,
+          symbol->name());
     }
   }
   if (auto chars{Procedure::Characterize(d, context_)}) {

diff  --git a/flang/test/Semantics/bindings03.f90 b/flang/test/Semantics/bindings03.f90
new file mode 100644
index 000000000000..84227348e203
--- /dev/null
+++ b/flang/test/Semantics/bindings03.f90
@@ -0,0 +1,26 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1 -Werror
+! Confirm a portability warning on use of a procedure binding apart from a call
+module m
+  type t
+   contains
+    procedure :: sub
+  end type
+ contains
+  subroutine sub(x)
+    class(t), intent(in) :: x
+  end subroutine
+end module
+
+program test
+  use m
+  procedure(sub), pointer :: p
+  type(t) x
+  !PORTABILITY: Procedure binding 'sub' used as target of a pointer assignment
+  p => x%sub
+  !PORTABILITY: Procedure binding 'sub' passed as an actual argument
+  call sub2(x%sub)
+ contains
+  subroutine sub2(s)
+    procedure(sub) s
+  end subroutine
+end