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

[via flang-commits]

Author: Peter Klausler
Date: 2023-11-30T11:59:19-08:00
New Revision: fcf5154a27ba27de91d9b4527a75daeb92563ff4

URL: https://github.com/llvm/llvm-project/commit/fcf5154a27ba27de91d9b4527a75daeb92563ff4
DIFF: https://github.com/llvm/llvm-project/commit/fcf5154a27ba27de91d9b4527a75daeb92563ff4.diff

LOG: [flang] Fix IsVariable() to be false for procedure pointers (#72577)

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

Added: 
    

Modified: 
    flang/include/flang/Evaluate/tools.h
    flang/test/Semantics/associated.f90

Removed: 
    


################################################################################
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