[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
This commit is contained in:
Leandro Lupori 2025-04-07 13:18:07 -03:00 committed by GitHub
parent 1847b00330
commit 01ec74dfd0
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
2 changed files with 45 additions and 2 deletions

View File

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

View File

@ -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