[flang-commits] [flang] 3dc314b - [flang] Fix lowering of unused dummy procedure pointers (#155649)

[via flang-commits]

Author: Leandro Lupori
Date: 2025-09-08T08:39:07-03:00
New Revision: 3dc314b8519099b1da43d01302d3d1710a6ccb3c

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

LOG: [flang] Fix lowering of unused dummy procedure pointers (#155649)

Fixes #126453

Added: 
    flang/test/Lower/HLFIR/dummy-proc-ptr-in-entry.f90

Modified: 
    flang/include/flang/Lower/CallInterface.h
    flang/lib/Lower/CallInterface.cpp
    flang/lib/Lower/ConvertVariable.cpp

Removed: 
    


################################################################################
diff  --git a/flang/include/flang/Lower/CallInterface.h b/flang/include/flang/Lower/CallInterface.h
index 72bc9dd890a94..926a42756c6ef 100644
--- a/flang/include/flang/Lower/CallInterface.h
+++ b/flang/include/flang/Lower/CallInterface.h
@@ -478,6 +478,12 @@ getOrDeclareFunction(const Fortran::evaluate::ProcedureDesignator &,
 mlir::Type getDummyProcedureType(const Fortran::semantics::Symbol &dummyProc,
                                  Fortran::lower::AbstractConverter &);
 
+/// Return the type of an argument that is a dummy procedure pointer. This
+/// will be a reference to a boxed procedure.
+mlir::Type
+getDummyProcedurePointerType(const Fortran::semantics::Symbol &dummyProcPtr,
+                             Fortran::lower::AbstractConverter &);
+
 /// Return !fir.boxproc<() -> ()> type.
 mlir::Type getUntypedBoxProcType(mlir::MLIRContext *context);
 

diff  --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp
index 72431a9cfacc4..c3284cd936f8f 100644
--- a/flang/lib/Lower/CallInterface.cpp
+++ b/flang/lib/Lower/CallInterface.cpp
@@ -1766,6 +1766,17 @@ mlir::Type Fortran::lower::getDummyProcedureType(
   return procType;
 }
 
+mlir::Type Fortran::lower::getDummyProcedurePointerType(
+    const Fortran::semantics::Symbol &dummyProcPtr,
+    Fortran::lower::AbstractConverter &converter) {
+  std::optional<Fortran::evaluate::characteristics::Procedure> iface =
+      Fortran::evaluate::characteristics::Procedure::Characterize(
+          dummyProcPtr, converter.getFoldingContext());
+  mlir::Type procPtrType = getProcedureDesignatorType(
+      iface.has_value() ? &*iface : nullptr, converter);
+  return fir::ReferenceType::get(procPtrType);
+}
+
 bool Fortran::lower::isCPtrArgByValueType(mlir::Type ty) {
   return mlir::isa<fir::ReferenceType>(ty) &&
          fir::isa_integer(fir::unwrapRefType(ty));

diff  --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index 88fc3128d21f7..c79c9b1ab0f51 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -2159,15 +2159,19 @@ void Fortran::lower::mapSymbolAttributes(
   if (Fortran::semantics::IsProcedure(sym)) {
     if (isUnusedEntryDummy) {
       // Additional discussion below.
-      mlir::Type dummyProcType =
-          Fortran::lower::getDummyProcedureType(sym, converter);
-      mlir::Value undefOp = fir::UndefOp::create(builder, loc, dummyProcType);
-
-      Fortran::lower::genDeclareSymbol(converter, symMap, sym, undefOp);
-    }
-
-    // Procedure pointer.
-    if (Fortran::semantics::IsPointer(sym)) {
+      if (Fortran::semantics::IsPointer(sym)) {
+        mlir::Type procPtrType =
+            Fortran::lower::getDummyProcedurePointerType(sym, converter);
+        mlir::Value undefOp = fir::UndefOp::create(builder, loc, procPtrType);
+        genProcPointer(converter, symMap, sym, undefOp, replace);
+      } else {
+        mlir::Type dummyProcType =
+            Fortran::lower::getDummyProcedureType(sym, converter);
+        mlir::Value undefOp = fir::UndefOp::create(builder, loc, dummyProcType);
+        Fortran::lower::genDeclareSymbol(converter, symMap, sym, undefOp);
+      }
+    } else if (Fortran::semantics::IsPointer(sym)) {
+      // Used procedure pointer.
       // global
       mlir::Value boxAlloc = preAlloc;
       // dummy or passed result

diff  --git a/flang/test/Lower/HLFIR/dummy-proc-ptr-in-entry.f90 b/flang/test/Lower/HLFIR/dummy-proc-ptr-in-entry.f90
new file mode 100644
index 0000000000000..280268112d5a0
--- /dev/null
+++ b/flang/test/Lower/HLFIR/dummy-proc-ptr-in-entry.f90
@@ -0,0 +1,59 @@
+! Test dummy procedure pointers that are not an argument in every entry.
+! This requires creating a mock value in the entries where it is not an
+! argument.
+!
+!RUN: %flang_fc1 -emit-hlfir %s -o - 2>&1 | FileCheck %s
+
+!CHECK-LABEL: func @_QPdummy_char_proc_ptr() -> !fir.boxproc<(!fir.ref<!fir.char<1>>, index) -> !fir.boxchar<1>> {
+!CHECK:         %[[UNDEF:.*]] = fir.undefined !fir.ref<!fir.boxproc<() -> ()>>
+!CHECK:         %{{.*}}:2 = hlfir.declare %[[UNDEF]]
+!CHECK-SAME:      {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFdummy_char_proc_ptrEdummy"}
+!CHECK-SAME:      : (!fir.ref<!fir.boxproc<() -> ()>>)
+!CHECK-SAME:      -> (!fir.ref<!fir.boxproc<() -> ()>>, !fir.ref<!fir.boxproc<() -> ()>>)
+
+!CHECK-LABEL: func @_QPdummy_char_proc_ptr_entry(
+!CHECK-SAME:        %[[ARG:.*]]: !fir.ref<!fir.boxproc<() -> ()>>)
+!CHECK-SAME:        -> !fir.boxproc<(!fir.ref<!fir.char<1>>, index) -> !fir.boxchar<1>> {
+!CHECK:         %{{.*}}:2 = hlfir.declare %[[ARG]] dummy_scope %{{[^ ]*}}
+!CHECK-SAME:      {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFdummy_char_proc_ptrEdummy"}
+!CHECK-SAME:      : (!fir.ref<!fir.boxproc<() -> ()>>, !fir.dscope)
+!CHECK-SAME:      -> (!fir.ref<!fir.boxproc<() -> ()>>, !fir.ref<!fir.boxproc<() -> ()>>)
+function dummy_char_proc_ptr() result(fun)
+  interface
+    character function char_fun()
+    end function
+  end interface
+
+  procedure (char_fun), pointer :: fun, dummy_char_proc_ptr_entry, dummy
+  fun => null()
+  return
+
+  entry dummy_char_proc_ptr_entry(dummy)
+end function
+
+!CHECK-LABEL: func @_QPdummy_int_proc_ptr()
+!CHECK:         %[[UNDEF:.*]] = fir.undefined !fir.ref<!fir.boxproc<() -> ()>>
+!CHECK:         %{{.*}}:2 = hlfir.declare %[[UNDEF]]
+!CHECK-SAME:      {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFdummy_int_proc_ptrEdummy"}
+!CHECK-SAME:      : (!fir.ref<!fir.boxproc<() -> ()>>)
+!CHECK-SAME:      -> (!fir.ref<!fir.boxproc<() -> ()>>, !fir.ref<!fir.boxproc<() -> ()>>)
+
+!CHECK-LABEL: func @_QPdummy_int_proc_ptr_entry(
+!CHECK-SAME:        %[[ARG:.*]]: !fir.ref<!fir.boxproc<() -> ()>>)
+!CHECK-SAME:        -> !fir.boxproc<() -> i32> {
+!CHECK:         %{{.*}}:2 = hlfir.declare %[[ARG]] dummy_scope %{{[^ ]*}}
+!CHECK-SAME:      {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFdummy_int_proc_ptrEdummy"}
+!CHECK-SAME:      : (!fir.ref<!fir.boxproc<() -> ()>>, !fir.dscope)
+!CHECK-SAME:      -> (!fir.ref<!fir.boxproc<() -> ()>>, !fir.ref<!fir.boxproc<() -> ()>>)
+function dummy_int_proc_ptr() result(fun)
+  interface
+    integer function int_fun()
+    end function
+  end interface
+
+  procedure (int_fun), pointer :: fun, dummy_int_proc_ptr_entry, dummy
+  fun => null()
+  return
+
+  entry dummy_int_proc_ptr_entry(dummy)
+end function