[flang-commits] [flang] [flang] Fix IsVariable() to be false for procedure pointers (PR #72577)

[Peter Klausler via flang-commits]

https://github.com/klausler created https://github.com/llvm/llvm-project/pull/72577

The implementation of the predicate evaluate::IsVariable() needs to recognize procedure pointers and return a false result for them.

>From 3f57692178089e9c02168ef37facdb7d6887fa9a Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Thu, 16 Nov 2023 14:09:08 -0800
Subject: [PATCH] [flang] Fix IsVariable() to be false for procedure pointers

The implementation of the predicate evaluate::IsVariable() needs
to recognize procedure pointers and return a false result for them.
---
 flang/include/flang/Evaluate/tools.h | 7 +++++++
 flang/test/Semantics/associated.f90  | 3 +++
 2 files changed, 10 insertions(+)

diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h
index 55262a912d95629..ba065c4ee1b174e 100644
--- a/flang/include/flang/Evaluate/tools.h
+++ b/flang/include/flang/Evaluate/tools.h
@@ -59,6 +59,13 @@ struct IsVariableHelper
         }
       }
       return false;
+    } else if constexpr (std::is_same_v<T, SomeType>) {
+      if (std::holds_alternative<ProcedureDesignator>(x.u) ||
+          std::holds_alternative<ProcedureRef>(x.u)) {
+        return false; // procedure pointer
+      } else {
+        return (*this)(x.u);
+      }
     } else {
       return (*this)(x.u);
     }
diff --git a/flang/test/Semantics/associated.f90 b/flang/test/Semantics/associated.f90
index bf8bcf474986336..1da94d28ae6bacc 100644
--- a/flang/test/Semantics/associated.f90
+++ b/flang/test/Semantics/associated.f90
@@ -92,6 +92,7 @@ subroutine test(assumedRank)
     integer, target :: targetIntArr(2)
     integer, target :: targetIntCoarray[*]
     integer, pointer :: intPointerArr(:)
+    procedure(objPtrFunc), pointer :: objPtrFuncPointer
 
     !ERROR: Assumed-rank array cannot be forwarded to 'target=' argument
     lvar = associated(assumedRank, assumedRank)
@@ -204,6 +205,8 @@ subroutine test(assumedRank)
     lvar = associated(intProcPointer1, elementalProc)
     !ERROR: POINTER= argument 'intpointervar1' is an object pointer but the TARGET= argument 'intfunc' is not a variable
     lvar = associated (intPointerVar1, intFunc)
+    !ERROR: POINTER= argument 'intpointervar1' is an object pointer but the TARGET= argument 'objptrfuncpointer' is not a variable
+    lvar = associated (intPointerVar1, objPtrFuncPointer)
     !ERROR: In assignment to object pointer 'intpointervar1', the target 'intfunc' is a procedure designator
     intPointerVar1 => intFunc
     !ERROR: In assignment to procedure pointer 'intprocpointer1', the target is not a procedure or procedure pointer