[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:
parent
1847b00330
commit
01ec74dfd0
@ -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));
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
42
flang/test/Lower/OpenMP/copyprivate3.f90
Normal file
42
flang/test/Lower/OpenMP/copyprivate3.f90
Normal 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
|
||||
Loading…
x
Reference in New Issue
Block a user