[flang] Catch coindexed procedure pointer/binding references (#129931)

A procedure designator cannot be coindexed, except for cases in which
the coindexing doesn't matter (i.e. a binding that can't be overridden).

Author: klausler

flang/include/flang/Evaluate/tools.h

@@ -464,9 +464,13 @@ struct ExtractCoindexedObjectHelper {
   }
 };
 
+static inline std::optional<CoarrayRef> ExtractCoarrayRef(const DataRef &x) {
+  return ExtractCoindexedObjectHelper{}(x);
+}
+
 template <typename A> std::optional<CoarrayRef> ExtractCoarrayRef(const A &x) {
   if (auto dataRef{ExtractDataRef(x, true)}) {
-    return ExtractCoindexedObjectHelper{}(*dataRef);
+    return ExtractCoarrayRef(*dataRef);
   } else {
     return ExtractCoindexedObjectHelper{}(x);
   }

flang/lib/Semantics/expression.cpp

@@ -2530,6 +2530,15 @@ auto ExpressionAnalyzer::AnalyzeProcedureComponentRef(
           return CalleeAndArguments{
               ProcedureDesignator{*resolution}, std::move(arguments)};
         } else if (dataRef.has_value()) {
+          if (ExtractCoarrayRef(*dataRef)) {
+            if (IsProcedurePointer(*sym)) {
+              Say(sc.component.source,
+                  "Base of procedure component reference may not be coindexed"_err_en_US);
+            } else {
+              Say(sc.component.source,
+                  "A procedure binding may not be coindexed unless it can be resolved at compilation time"_err_en_US);
+            }
+          }
           if (sym->attrs().test(semantics::Attr::NOPASS)) {
             const auto *dtSpec{GetDerivedTypeSpec(dtExpr->GetType())};
             if (dtSpec && dtSpec->scope()) {

flang/test/Semantics/bindings01.f90

@@ -293,6 +293,48 @@ subroutine t2p
   end
 end
 
+module m12
+  type t
+    procedure(sub), pointer, nopass :: pp
+   contains
+    procedure, non_overridable, nopass :: tbp1 => sub
+    procedure, nopass :: tbp2 => sub
+    generic :: gen1 => tbp1
+    generic :: gen2 => tbp2
+  end type
+ contains
+  subroutine sub
+  end
+  subroutine test(x, y)
+    class(t) :: x[*]
+    type(t) :: y[*]
+    call x%pp ! ok
+    call y%pp ! ok
+    !ERROR: Base of procedure component reference may not be coindexed
+    call x[1]%pp
+    !ERROR: Base of procedure component reference may not be coindexed
+    call y[1]%pp
+    call x%tbp1 ! ok
+    call y%tbp1 ! ok
+    call x[1]%tbp1 ! ok
+    call y[1]%tbp1 ! ok
+    call x%tbp2 ! ok
+    call y%tbp2 ! ok
+    !ERROR: A procedure binding may not be coindexed unless it can be resolved at compilation time
+    call x[1]%tbp2
+    call y[1]%tbp2 ! ok
+    call x%gen1 ! ok
+    call y%gen1 ! ok
+    call x[1]%gen1 ! ok
+    call y[1]%gen1 ! ok
+    call x%gen2 ! ok
+    call y%gen2 ! ok
+    !ERROR: A procedure binding may not be coindexed unless it can be resolved at compilation time
+    call x[1]%gen2
+    call y[1]%gen2 ! ok
+  end
+end
+
 program test
   use m1
   type,extends(t) :: t2