[flang-commits] [flang] [flang][lowering] handle procedure pointers with generic name (PR #108043)

[via flang-commits]

https://github.com/jeanPerier updated https://github.com/llvm/llvm-project/pull/108043

>From eb442b397436b5e8be0d978fca4a7c94c7b4cfc1 Mon Sep 17 00:00:00 2001
From: Jean Perier <jperier at nvidia.com>
Date: Tue, 10 Sep 2024 08:19:12 -0700
Subject: [PATCH 1/2] [flang][lowering] handle procedure pointers with generic
 name

---
 flang/lib/Lower/PFTBuilder.cpp                |  9 +++-
 .../HLFIR/procedure-pointer-in-generics.f90   | 46 +++++++++++++++++++
 2 files changed, 54 insertions(+), 1 deletion(-)
 create mode 100644 flang/test/Lower/HLFIR/procedure-pointer-in-generics.f90

diff --git a/flang/lib/Lower/PFTBuilder.cpp b/flang/lib/Lower/PFTBuilder.cpp
index 5b3d5471925bff..845c007d5e5f77 100644
--- a/flang/lib/Lower/PFTBuilder.cpp
+++ b/flang/lib/Lower/PFTBuilder.cpp
@@ -1566,6 +1566,14 @@ struct SymbolDependenceAnalysis {
       return 0;
     LLVM_DEBUG(llvm::dbgs() << "analyze symbol " << &sym << " in <"
                             << &sym.owner() << ">: " << sym << '\n');
+    semantics::Symbol ultimate = sym.GetUltimate();
+    if (const auto *details = ultimate.detailsIf<semantics::GenericDetails>()) {
+      // Procedure pointers may be "hidden" behind to the generic symbol if they
+      // have the same name.
+      if (const semantics::Symbol *specific{details->specific()})
+        analyze(*specific);
+      return 0;
+    }
     const bool isProcedurePointerOrDummy =
         semantics::IsProcedurePointer(sym) ||
         (semantics::IsProcedure(sym) && IsDummy(sym));
@@ -1582,7 +1590,6 @@ struct SymbolDependenceAnalysis {
     if (sym.owner().IsDerivedType())
       return 0;
 
-    semantics::Symbol ultimate = sym.GetUltimate();
     if (const auto *details =
             ultimate.detailsIf<semantics::NamelistDetails>()) {
       // handle namelist group symbols
diff --git a/flang/test/Lower/HLFIR/procedure-pointer-in-generics.f90 b/flang/test/Lower/HLFIR/procedure-pointer-in-generics.f90
new file mode 100644
index 00000000000000..ff447d31b1af1c
--- /dev/null
+++ b/flang/test/Lower/HLFIR/procedure-pointer-in-generics.f90
@@ -0,0 +1,46 @@
+! Test procedure pointers with the same name as generics.
+! RUN: bbc -emit-hlfir -o - %s | FileCheck %s
+
+module m_gen
+  procedure(func), pointer :: foo
+  interface foo
+     procedure :: foo
+  end interface
+  interface
+    real function func(x)
+      real :: x
+    end function
+  end interface
+end
+!CHECK-LABEL:   fir.global @_QMm_genEfoo : !fir.boxproc<(!fir.ref<f32>) -> f32> {
+!CHECK:           %[[VAL_0:.*]] = fir.zero_bits (!fir.ref<f32>) -> f32
+!CHECK:           %[[VAL_1:.*]] = fir.emboxproc %[[VAL_0]] : ((!fir.ref<f32>) -> f32) -> !fir.boxproc<(!fir.ref<f32>) -> f32>
+!CHECK:           fir.has_value %[[VAL_1]] : !fir.boxproc<(!fir.ref<f32>) -> f32>
+
+subroutine test1()
+  use m_gen
+  foo => func
+end subroutine
+!CHECK-LABEL:   func.func @_QPtest1() {
+!CHECK:           %[[VAL_0:.*]] = fir.address_of(@_QMm_genEfoo) : !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>
+!CHECK:           %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {{.*}}"_QMm_genEfoo"{{.*}} : (!fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>) -> (!fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>, !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>)
+!CHECK:           %[[VAL_2:.*]] = fir.address_of(@_QPfunc) : (!fir.ref<f32>) -> f32
+!CHECK:           %[[VAL_3:.*]] = fir.emboxproc %[[VAL_2]] : ((!fir.ref<f32>) -> f32) -> !fir.boxproc<() -> ()>
+!CHECK:           %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.boxproc<() -> ()>) -> !fir.boxproc<(!fir.ref<f32>) -> f32>
+!CHECK:           fir.store %[[VAL_4]] to %[[VAL_1]]#0 : !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>
+
+subroutine test_local()
+  use m_gen, only : func
+  procedure(func), pointer :: foo
+  interface foo
+     procedure :: foo
+  end interface
+  foo => func
+end subroutine
+!CHECK-LABEL:   func.func @_QPtest_local() {
+!CHECK:           %[[VAL_0:.*]] = fir.alloca !fir.boxproc<(!fir.ref<f32>) -> f32> {bindc_name = "foo", uniq_name = "_QFtest_localEfoo"}
+!CHECK:           %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]] {{.*}}"_QFtest_localEfoo"{{.*}} : (!fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>) -> (!fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>, !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>)
+!CHECK:           %[[VAL_4:.*]] = fir.address_of(@_QPfunc) : (!fir.ref<f32>) -> f32
+!CHECK:           %[[VAL_5:.*]] = fir.emboxproc %[[VAL_4]] : ((!fir.ref<f32>) -> f32) -> !fir.boxproc<() -> ()>
+!CHECK:           %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (!fir.boxproc<() -> ()>) -> !fir.boxproc<(!fir.ref<f32>) -> f32>
+!CHECK:           fir.store %[[VAL_6]] to %[[VAL_3]]#0 : !fir.ref<!fir.boxproc<(!fir.ref<f32>) -> f32>>

>From 3b021f5f422845a6e2bf9409c32873b415612a8b Mon Sep 17 00:00:00 2001
From: Jean Perier <jperier at nvidia.com>
Date: Tue, 10 Sep 2024 11:52:12 -0700
Subject: [PATCH 2/2] clang format

---
 flang/lib/Lower/PFTBuilder.cpp | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/flang/lib/Lower/PFTBuilder.cpp b/flang/lib/Lower/PFTBuilder.cpp
index 845c007d5e5f77..793e291a168adf 100644
--- a/flang/lib/Lower/PFTBuilder.cpp
+++ b/flang/lib/Lower/PFTBuilder.cpp
@@ -1566,11 +1566,11 @@ struct SymbolDependenceAnalysis {
       return 0;
     LLVM_DEBUG(llvm::dbgs() << "analyze symbol " << &sym << " in <"
                             << &sym.owner() << ">: " << sym << '\n');
-    semantics::Symbol ultimate = sym.GetUltimate();
+    const semantics::Symbol &ultimate = sym.GetUltimate();
     if (const auto *details = ultimate.detailsIf<semantics::GenericDetails>()) {
       // Procedure pointers may be "hidden" behind to the generic symbol if they
       // have the same name.
-      if (const semantics::Symbol *specific{details->specific()})
+      if (const semantics::Symbol *specific = details->specific())
         analyze(*specific);
       return 0;
     }