[flang] Document and warn about an extension

[klausler]

Summary

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.

[clementval]

LGTM

flang/docs/Extensions.md

* The legacy extension intrinsic functions `IZEXT` and `JZEXT`
   compilers, so it is not supported.
 * f18 doesn't impose a limit on the number of continuation lines
   allowed for a single statement.
 * When a type-bound procedure declaration statement has neither interface
   nor attributes, the "::" before the bindings is optional, even
   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
 
 * C-style backslash escape sequences in quoted CHARACTER literals
   (but not Hollerith) [-fbackslash]
 * Logical abbreviations `.T.`, `.F.`, `.N.`, `.A.`, `.O.`, and `.X.`
   [-flogical-abbreviations]
 * `.XOR.` as a synonym for `.NEQV.` [-fxor-operator]

flang/lib/Semantics/check-call.cpp

if (argProcSymbol) {
       if (const auto *subp{
               argProcSymbol->GetUltimate().detailsIf<SubprogramDetails>()}) {
         if (subp->stmtFunction()) {
           evaluate::SayWithDeclaration(messages, *argProcSymbol,
               "Statement function '%s' may not be passed as an actual argument"_err_en_US,
               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(
             "actual argument", *expr, context)}) {
       if (!argChars->IsTypelessIntrinsicDummy()) {
         if (auto *argProc{
                 std::get_if<characteristics::DummyProcedure>(&argChars->u)}) {
           characteristics::Procedure &argInterface{argProc->procedure.value()};

flang/lib/Semantics/pointer-assignment.cpp

if (const Symbol * symbol{d.GetSymbol()}) {
     if (const auto *subp{
             symbol->GetUltimate().detailsIf<SubprogramDetails>()}) {
       if (subp->stmtFunction()) {
         evaluate::SayWithDeclaration(context_.messages(), *symbol,
             "Statement function '%s' may not be the target of a pointer assignment"_err_en_US,
             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_)}) {
     return Check(d.GetName(), false, &*chars, d.GetSpecificIntrinsic());
   } else {
     return Check(d.GetName(), false);
   }
 }

flang/test/Semantics/bindings03.f90

+! 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