[flang-commits] [flang] 01ec74d - [flang][OpenMP] Fix copyprivate of procedure pointers (#134292)

[via flang-commits]

Author: Leandro Lupori
Date: 2025-04-07T13:18:07-03:00
New Revision: 01ec74dfd0db307a3b67cc67448269231cd2e83c

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

LOG: [flang][OpenMP] Fix copyprivate of procedure pointers (#134292)

Just modify the assert to consider fir::BoxProcType as valid. No
other changes are needed.

Fixes #131549

Added: 
    flang/test/Lower/OpenMP/copyprivate3.f90

Modified: 
    flang/lib/Lower/OpenMP/ClauseProcessor.cpp

Removed: 
    


################################################################################
diff  --git a/flang/lib/Lower/OpenMP/ClauseProcessor.cpp b/flang/lib/Lower/OpenMP/ClauseProcessor.cpp
index 12ac6b3285575..46febd33f0ce8 100644
--- a/flang/lib/Lower/OpenMP/ClauseProcessor.cpp
+++ b/flang/lib/Lower/OpenMP/ClauseProcessor.cpp
@@ -695,9 +695,10 @@ void TypeInfo::typeScan(mlir::Type ty) {
   } else if (auto pty = mlir::dyn_cast<fir::PointerType>(ty)) {
     typeScan(pty.getEleTy());
   } else {
-    // The scan ends when reaching any built-in or record type.
+    // The scan ends when reaching any built-in, record or boxproc type.
     assert(ty.isIntOrIndexOrFloat() || mlir::isa<mlir::ComplexType>(ty) ||
-           mlir::isa<fir::LogicalType>(ty) || mlir::isa<fir::RecordType>(ty));
+           mlir::isa<fir::LogicalType>(ty) || mlir::isa<fir::RecordType>(ty) ||
+           mlir::isa<fir::BoxProcType>(ty));
   }
 }
 

diff  --git a/flang/test/Lower/OpenMP/copyprivate3.f90 b/flang/test/Lower/OpenMP/copyprivate3.f90
new file mode 100644
index 0000000000000..13926e45f1948
--- /dev/null
+++ b/flang/test/Lower/OpenMP/copyprivate3.f90
@@ -0,0 +1,42 @@
+! Test lowering of COPYPRIVATE with procedure pointers.
+! RUN: %flang_fc1 -emit-hlfir -fopenmp -o - %s 2>&1 | FileCheck %s
+
+!CHICK-SAME:    %arg0: [[TYPE:!fir.ref<!fir.boxproc<() -> i32>>>]],
+
+!CHECK-LABEL: func.func private @_copy_boxproc_i32_args(
+!CHECK-SAME:        %arg0: [[TYPE:!fir.ref<!fir.boxproc<\(\) -> i32>>]],
+!CHECK-SAME:        %arg1: [[TYPE]])
+!CHECK:         %[[DST:.*]]:2 = hlfir.declare %arg0 {{.*}} : ([[TYPE]]) -> ([[TYPE]], [[TYPE]])
+!CHECK:         %[[SRC:.*]]:2 = hlfir.declare %arg1 {{.*}} : ([[TYPE]]) -> ([[TYPE]], [[TYPE]])
+!CHECK:         %[[TEMP:.*]] = fir.load %[[SRC]]#0 : [[TYPE]]
+!CHECK:         fir.store %[[TEMP]] to %[[DST]]#0 : [[TYPE]]
+!CHECK:         return
+
+!CHECK-LABEL: func @_QPtest_proc_ptr
+!CHECK:         omp.parallel
+!CHECK:           omp.single copyprivate(%{{.*}}#0 -> @_copy_boxproc_i32_args : !fir.ref<!fir.boxproc<() -> i32>>)
+subroutine test_proc_ptr()
+  interface
+     function sub1() bind(c) result(ret)
+       use, intrinsic :: iso_c_binding
+       integer(c_int) :: ret
+     end function sub1
+  end interface
+
+  procedure(sub1), pointer, save, bind(c) :: ffunptr
+  !$omp threadprivate(ffunptr)
+
+  !$omp parallel
+    ffunptr => sub1
+    !$omp single
+      ffunptr => sub1
+    !$omp end single copyprivate(ffunptr)
+    if (ffunptr() /= 1) print *, 'err'
+  !$omp end parallel
+end subroutine
+
+function sub1() bind(c) result(ret)
+  use, intrinsic::iso_c_binding
+  integer(c_int) :: ret
+  ret = 1
+end function sub1