[flang-commits] [flang] a4ac099 - [Flang] Support passing a function that returns procedure pointer as actual corresponding to a procedure dummy. (#80891)

[via flang-commits]

Author: Daniel Chen
Date: 2024-02-10T11:00:00-05:00
New Revision: a4ac099487d057dde8151700b3802eaeb69cead2

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

LOG: [Flang] Support passing a function that returns procedure pointer as actual corresponding to a procedure dummy. (#80891)

Flang crashes with the following case. The problem is we missed the case
when passing a reference to a function that returns a procedure pointer
as actual that corresponds to a procedure dummy. This PR is to fix that.

```
  PROGRAM main
  IMPLICIT NONE
  INTERFACE
    FUNCTION IntF(Arg)
      integer :: Arg, IntF
    END FUNCTION
  END INTERFACE

  INTERFACE
    FUNCTION RetPtr(Arg)
      IMPORT
      PROCEDURE(IntF) :: Arg
      PROCEDURE(IntF), POINTER :: RetPtr
    END FUNCTION
  END INTERFACE

  CALL ModSub(RetPtr(IntF))
  contains
    SUBROUTINE ModSub(Fun1)
    PROCEDURE(IntF) :: Fun1
    END SUBROUTINE
  END
  ```

Added: 
    

Modified: 
    flang/lib/Lower/ConvertCall.cpp

Removed: 
    


################################################################################
diff  --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index f60cdbb690e7cd..d8271b1f14635c 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -922,7 +922,8 @@ static PreparedDummyArgument preparePresentUserCallActualArgument(
   // Handle procedure arguments (procedure pointers should go through
   // prepareProcedurePointerActualArgument).
   if (hlfir::isFortranProcedureValue(dummyType)) {
-    // Procedure pointer actual to procedure dummy.
+    // Procedure pointer or function returns procedure pointer actual to
+    // procedure dummy.
     if (actual.isProcedurePointer()) {
       actual = hlfir::derefPointersAndAllocatables(loc, builder, actual);
       return PreparedDummyArgument{actual, /*cleanups=*/{}};
@@ -931,7 +932,11 @@ static PreparedDummyArgument preparePresentUserCallActualArgument(
     assert(actual.isProcedure());
     // Do nothing if this is a procedure argument. It is already a
     // fir.boxproc/fir.tuple<fir.boxproc, len> as it should.
-    if (actual.getType() != dummyType)
+    if (!actual.getType().isa<fir::BoxProcType>() &&
+        actual.getType() != dummyType)
+      // The actual argument may be a procedure that returns character (a
+      // fir.tuple<fir.boxproc, len>) while the dummy is not. Extract the tuple
+      // in that case.
       actual = fixProcedureDummyMismatch(loc, builder, actual, dummyType);
     return PreparedDummyArgument{actual, /*cleanups=*/{}};
   }