43 lines · plain
1! Test lowering of COPYPRIVATE with procedure pointers.2! RUN: %flang_fc1 -emit-hlfir -fopenmp -o - %s 2>&1 | FileCheck %s3 4!CHICK-SAME: %arg0: [[TYPE:!fir.ref<!fir.boxproc<() -> i32>>>]],5 6!CHECK-LABEL: func.func private @_copy_boxproc_i32_args(7!CHECK-SAME: %arg0: [[TYPE:!fir.ref<!fir.boxproc<\(\) -> i32>>]],8!CHECK-SAME: %arg1: [[TYPE]])9!CHECK: %[[DST:.*]]:2 = hlfir.declare %arg0 {{.*}} : ([[TYPE]]) -> ([[TYPE]], [[TYPE]])10!CHECK: %[[SRC:.*]]:2 = hlfir.declare %arg1 {{.*}} : ([[TYPE]]) -> ([[TYPE]], [[TYPE]])11!CHECK: %[[TEMP:.*]] = fir.load %[[SRC]]#0 : [[TYPE]]12!CHECK: fir.store %[[TEMP]] to %[[DST]]#0 : [[TYPE]]13!CHECK: return14 15!CHECK-LABEL: func @_QPtest_proc_ptr16!CHECK: omp.parallel17!CHECK: omp.single copyprivate(%{{.*}}#0 -> @_copy_boxproc_i32_args : !fir.ref<!fir.boxproc<() -> i32>>)18subroutine test_proc_ptr()19 interface20 function sub1() bind(c) result(ret)21 use, intrinsic :: iso_c_binding22 integer(c_int) :: ret23 end function sub124 end interface25 26 procedure(sub1), pointer, save, bind(c) :: ffunptr27 !$omp threadprivate(ffunptr)28 29 !$omp parallel30 ffunptr => sub131 !$omp single32 ffunptr => sub133 !$omp end single copyprivate(ffunptr)34 if (ffunptr() /= 1) print *, 'err'35 !$omp end parallel36end subroutine37 38function sub1() bind(c) result(ret)39 use, intrinsic::iso_c_binding40 integer(c_int) :: ret41 ret = 142end function sub143