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

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

Fixes llvm#131549

Author: luporl

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));
   }
 }
 

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