[flang] INTENT(IN) pointer may not be forwarded to INTENT(IN OUT) or (OUT) dummy

[klausler]

Summary

19.6.8 forbids using an INTENT(IN) pointer dummy argument in a pointer association
context, and associated such a pointer with a dummy argument of INTENT(IN OUT) or
INTENT(OUT) is a circumstance that needs to be caught as an error.

flang/lib/Semantics/check-call.cpp

 
   // Definability
   const char *reason{nullptr};
+  bool dummyIsPointer{
+      dummy.attrs.test(characteristics::DummyDataObject::Attr::Pointer)};
   if (dummy.intent == common::Intent::Out) {
     reason = "INTENT(OUT)";
   } else if (dummy.intent == common::Intent::InOut) {
     reason = "INTENT(IN OUT)";
   }
   if (reason && scope) {
-    DefinabilityFlags flags;
+    // Problems with polymorphism are caught in the callee's definition.
+    DefinabilityFlags flags{DefinabilityFlag::PolymorphicOkInPure};
     if (isElemental || dummyIsValue) { // 15.5.2.4(21)
       flags.set(DefinabilityFlag::VectorSubscriptIsOk);
     }
+    if (actualIsPointer && dummyIsPointer) { // 19.6.8
+      flags.set(DefinabilityFlag::PointerDefinition);
+    }
     if (auto whyNot{WhyNotDefinable(messages.at(), *scope, flags, actual)}) {
       if (auto *msg{messages.Say(
               "Actual argument associated with %s %s is not definable"_err_en_US,

   bool actualIsContiguous{IsSimplyContiguous(actual, context)};
   bool dummyIsAssumedShape{dummy.type.attrs().test(
       characteristics::TypeAndShape::Attr::AssumedShape)};
-  bool dummyIsPointer{
-      dummy.attrs.test(characteristics::DummyDataObject::Attr::Pointer)};
   bool dummyIsContiguous{
       dummy.attrs.test(characteristics::DummyDataObject::Attr::Contiguous)};
   if ((actualIsAsynchronous || actualIsVolatile) &&

     }
     if (dummyIsPointer && dummy.intent != common::Intent::In) {
       const Symbol *last{GetLastSymbol(*expr)};
-      if (!(last && IsProcedurePointer(*last)) &&
-          !(dummy.intent == common::Intent::Default &&
-              IsNullProcedurePointer(*expr))) {
+      if (last && IsProcedurePointer(*last)) {
+        if (dummy.intent != common::Intent::Default &&
+            IsIntentIn(last->GetUltimate())) { // 19.6.8
+          messages.Say(
+              "Actual argument associated with procedure pointer %s may not be INTENT(IN)"_err_en_US,
+              dummyName);
+        }
+      } else if (!(dummy.intent == common::Intent::Default &&
+                     IsNullProcedurePointer(*expr))) {
         // 15.5.2.9(5) -- dummy procedure POINTER
         // Interface compatibility has already been checked above
         messages.Say(

flang/test/Semantics/definable01.f90

 ! RUN: not %flang_fc1 -fsyntax-only %s 2>&1 | FileCheck %s
-! Test WhyNotModifiable() explanations
+! Test WhyNotDefinable() explanations
 
 module prot
   real, protected :: prot

     !CHECK: because: 'ptr' is externally visible via 'ptr' and not definable in a pure subprogram
     read(internal,*) ptr
   end subroutine
+  subroutine test3(objp, procp)
+    real, intent(in), pointer :: objp
+    procedure(sin), pointer, intent(in) :: procp
+    !CHECK: error: Actual argument associated with INTENT(IN OUT) dummy argument 'op=' is not definable
+    !CHECK: because: 'objp' is an INTENT(IN) dummy argument
+    call test3a(objp)
+    !CHECK: error: Actual argument associated with procedure pointer dummy argument 'pp=' may not be INTENT(IN)
+    call test3b(procp)
+  end subroutine
+  subroutine test3a(op)
+    real, intent(in out), pointer :: op
+  end subroutine
+  subroutine test3b(pp)
+    procedure(sin), pointer, intent(in out) :: pp
+  end subroutine
 end module