[flang] Catch non-constant targets for procedure pointer initialization (#86338)

Detect attempts to use non-constant targets, including internal
procedures, as initializers for procedure pointers, including components
of structure components being used as initializers.

Author: klausler

flang/lib/Evaluate/check-expression.cpp

@@ -358,10 +358,14 @@ bool IsInitialProcedureTarget(const semantics::Symbol &symbol) {
   const auto &ultimate{symbol.GetUltimate()};
   return common::visit(
       common::visitors{
-          [](const semantics::SubprogramDetails &subp) {
-            return !subp.isDummy();
+          [&](const semantics::SubprogramDetails &subp) {
+            return !subp.isDummy() && !subp.stmtFunction() &&
+                symbol.owner().kind() != semantics::Scope::Kind::MainProgram &&
+                symbol.owner().kind() != semantics::Scope::Kind::Subprogram;
+          },
+          [](const semantics::SubprogramNameDetails &x) {
+            return x.kind() != semantics::SubprogramKind::Internal;
           },
-          [](const semantics::SubprogramNameDetails &) { return true; },
           [&](const semantics::ProcEntityDetails &proc) {
             return !semantics::IsPointer(ultimate) && !proc.isDummy();
           },

flang/test/Semantics/structconst09.f90

@@ -0,0 +1,37 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
+! Structure constructors with bad pointer targets
+module m
+  real, target, save :: x
+  type t
+    real, pointer :: rp => x
+    procedure(f), pointer, nopass :: pp => f
+  end type
+ contains
+  real function f()
+    f = 0.
+  end
+  subroutine test(da, dp)
+    real, target :: y, da
+    procedure(f) dp
+    procedure(f), pointer :: lpp
+    external ext
+    type(t) :: a1 = t() ! ok
+    type(t) :: a2 = t(rp=x) ! ok
+    type(t) :: a3 = t(pp=f) ! ok
+    type(t) :: a4 = t(pp=ext) ! ok
+    !ERROR: Must be a constant value
+    type(t) :: a5 = t(rp=y)
+    !ERROR: Must be a constant value
+    type(t) :: a6 = t(rp=da)
+    !ERROR: Must be a constant value
+    type(t) :: a7 = t(pp=lpp)
+    !ERROR: Must be a constant value
+    type(t) :: a8 = t(pp=internal)
+    !ERROR: Must be a constant value
+    type(t) :: a9 = t(pp=dp)
+   contains
+    real function internal()
+      internal = 666.
+    end
+  end
+end