[flang-commits] [flang] [flang][OpenMP] Fix non-delayed privatization of dummy proc pointers (PR #232752)

[via flang-commits]

llvmorg-github-actions[bot] wrote:


<!--LLVM PR SUMMARY COMMENT-->
@llvm/pr-subscribers-flang-openmp

@llvm/pr-subscribers-flang-fir-hlfir

Author: Leandro Lupori (luporl)

<details>
<summary>Changes</summary>

Dummy procedure pointer arguments use an untyped
`!fir.boxproc<() -> ()>`, while other procedure pointer variables use
a typed `fir.boxproc`. This caused a type mismatch when using
firstprivate/lastprivate in SECTIONS, which doesn't use delayed
privatization.

Fix this by assigning to the privatized copy the same type as the
original variable's storage.

Fixes #<!-- -->197395

Assisted-By: Claude Opus 5.5


---
Full diff: https://github.com/llvm/llvm-project/pull/232752.diff


2 Files Affected:

- (modified) flang/lib/Lower/Bridge.cpp (+15-5) 
- (modified) flang/test/Lower/OpenMP/privatization-proc-ptr.f90 (+31) 


``````````diff
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index 12a27771d432ce..d4ed16a2ee4cca 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -960,14 +960,24 @@ class FirConverter : public Fortran::lower::AbstractConverter {
     Fortran::lower::SymbolBox hsb =
         lookupSymbol(hsym, /*symMap=*/nullptr, /*forceHlfirBase=*/true);
 
+    mlir::Type allocType =
+        Fortran::semantics::IsAllocatableOrObjectPointer(&hsym.GetUltimate())
+            ? hSymType
+            : symType;
+    // The type of a procedure pointer depends on how the original was created:
+    // dummy procedure pointers use an untyped `!fir.boxproc<() -> ()>`, while
+    // other procedure pointers carry their interface signature.
+    // Give the clone the same type as the original storage so that copies
+    // between them do not mix boxproc types.
+    if (Fortran::semantics::IsProcedurePointer(hsym.GetUltimate()))
+      if (mlir::Value hostAddr = hsb.getAddr())
+        allocType = fir::unwrapRefType(hostAddr.getType());
+
     auto allocate = [&](llvm::ArrayRef<mlir::Value> shape,
                         llvm::ArrayRef<mlir::Value> typeParams) -> mlir::Value {
       mlir::Value allocVal = builder->allocateLocal(
-          loc,
-          Fortran::semantics::IsAllocatableOrObjectPointer(&hsym.GetUltimate())
-              ? hSymType
-              : symType,
-          mangleName(sym), toStringRef(sym.GetUltimate().name()),
+          loc, allocType, mangleName(sym),
+          toStringRef(sym.GetUltimate().name()),
           /*pinned=*/true, shape, typeParams,
           sym.GetUltimate().attrs().test(Fortran::semantics::Attr::TARGET));
       return allocVal;
diff --git a/flang/test/Lower/OpenMP/privatization-proc-ptr.f90 b/flang/test/Lower/OpenMP/privatization-proc-ptr.f90
index 61e10734fd4a07..5e0795689b7fb1 100644
--- a/flang/test/Lower/OpenMP/privatization-proc-ptr.f90
+++ b/flang/test/Lower/OpenMP/privatization-proc-ptr.f90
@@ -111,6 +111,37 @@ subroutine test_sections
   !$omp end sections
 end subroutine
 
+! Dummy procedure pointers are stored as an untyped !fir.boxproc<() -> ()>.
+! Their private copies must use the same type so that the firstprivate and
+! lastprivate copies are type consistent.
+!CHECK-LABEL: func private @_QFPtest_sections_dummy
+!CHECK-SAME:    %[[ARG_PF:[^:]*]]: !fir.ref<!fir.boxproc<() -> ()>>
+!CHECK-SAME:    %[[ARG_PS:[^:]*]]: !fir.ref<!fir.boxproc<() -> ()>>
+!CHECK:       %[[PF:.*]]:2 = hlfir.declare %[[ARG_PF]] {{.*}}uniq_name("_QFFtest_sections_dummyEpf")
+!CHECK:       %[[PS:.*]]:2 = hlfir.declare %[[ARG_PS]] {{.*}}uniq_name("_QFFtest_sections_dummyEps")
+!CHECK:       %[[PRIV_PF_ADDR:.*]] = fir.alloca !fir.boxproc<() -> ()> {{.*}}uniq_name = "_QFFtest_sections_dummyEpf"
+!CHECK:       %[[PRIV_PF:.*]]:2 = hlfir.declare %[[PRIV_PF_ADDR]] {{.*}}uniq_name("_QFFtest_sections_dummyEpf")
+!CHECK:       %[[PF_VAL:.*]] = fir.load %[[PF]]#0 : !fir.ref<!fir.boxproc<() -> ()>>
+!CHECK:       fir.store %[[PF_VAL]] to %[[PRIV_PF]]#0 : !fir.ref<!fir.boxproc<() -> ()>>
+!CHECK:       %[[PRIV_PS_ADDR:.*]] = fir.alloca !fir.boxproc<() -> ()> {{.*}}uniq_name = "_QFFtest_sections_dummyEps"
+!CHECK:       %[[PRIV_PS:.*]]:2 = hlfir.declare %[[PRIV_PS_ADDR]] {{.*}}uniq_name("_QFFtest_sections_dummyEps")
+!CHECK:       %[[PS_VAL:.*]] = fir.load %[[PS]]#0 : !fir.ref<!fir.boxproc<() -> ()>>
+!CHECK:       fir.store %[[PS_VAL]] to %[[PRIV_PS]]#0 : !fir.ref<!fir.boxproc<() -> ()>>
+!CHECK:       omp.sections
+!CHECK:         %[[PF_VAL:.*]] = fir.load %[[PRIV_PF]]#0 : !fir.ref<!fir.boxproc<() -> ()>>
+!CHECK:         fir.store %[[PF_VAL]] to %[[PF]]#0 : !fir.ref<!fir.boxproc<() -> ()>>
+!CHECK:         %[[PS_VAL:.*]] = fir.load %[[PRIV_PS]]#0 : !fir.ref<!fir.boxproc<() -> ()>>
+!CHECK:         fir.store %[[PS_VAL]] to %[[PS]]#0 : !fir.ref<!fir.boxproc<() -> ()>>
+subroutine test_sections_dummy(pf, ps)
+  procedure(f), pointer :: pf
+  procedure(sub), pointer :: ps
+
+  !$omp sections firstprivate(pf, ps) lastprivate(pf, ps)
+    pf => f
+    ps => sub
+  !$omp end sections
+end subroutine
+
 integer function f(arg)
   integer :: arg
   f = arg

``````````

</details>


https://github.com/llvm/llvm-project/pull/232752