166 lines · plain
1! Test privatization of procedure pointers.2 3!RUN: %flang_fc1 -emit-hlfir -fopenmp -o - %s 2>&1 | FileCheck %s4!RUN: bbc -emit-hlfir -fopenmp -o - %s 2>&1 | FileCheck %s5 6program proc_ptr_test7 implicit none8 9contains10 11!CHECK: omp.private {type = private} @_QFFtest_namesEpf2_private_boxproc_z32_args_ref_3x4xf32_ref_z32 : !fir.boxproc<(!fir.ref<!fir.array<3x4xf32>>, !fir.ref<complex<f32>>) -> complex<f32>>12!CHECK: omp.private {type = private} @_QFFtest_namesEpf1_private_boxproc_f32_args_ref_f32 : !fir.boxproc<(!fir.ref<f32>) -> f32>13!CHECK: omp.private {type = private} @_QFFtest_namesEpf0_private_boxproc_i32_args : !fir.boxproc<() -> i32>14!CHECK: omp.private {type = private} @_QFFtest_namesEps2_private_boxproc__args_ref_i32_boxchar_c8xU : !fir.boxproc<(!fir.ref<i32>, !fir.boxchar<1>) -> ()>15!CHECK: omp.private {type = private} @_QFFtest_namesEps1_private_boxproc__args_ref_i32 : !fir.boxproc<(!fir.ref<i32>) -> ()>16!CHECK: omp.private {type = private} @_QFFtest_namesEps0_private_boxproc__args : !fir.boxproc<() -> ()>17 18!CHECK: omp.private {type = private} @_QFFtest_lastprivateEps_private_boxproc__args_ref_i32 : !fir.boxproc<(!fir.ref<i32>) -> ()>19!CHECK: omp.private {type = private} @_QFFtest_lastprivateEpf_private_boxproc_i32_args_ref_i32 : !fir.boxproc<(!fir.ref<i32>) -> i32>20 21!CHECK: omp.private {type = firstprivate} @_QFFtest_firstprivateEps_firstprivate_boxproc__args_ref_i32 : !fir.boxproc<(!fir.ref<i32>) -> ()> copy {22!CHECK: ^bb0(%[[ARG0:.*]]: !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> ()>>, %[[ARG1:.*]]: !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> ()>>):23!CHECK: %[[TEMP:.*]] = fir.load %[[ARG0]] : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> ()>>24!CHECK: fir.store %[[TEMP]] to %[[ARG1]] : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> ()>>25!CHECK: omp.yield(%[[ARG1]] : !fir.ref<!fir.boxproc<(!fir.ref<i32>) -> ()>>)26!CHECK: }27 28!CHECK: omp.private {type = firstprivate} @_QFFtest_firstprivateEpf_firstprivate_boxproc_i32_args_ref_i32 : !fir.boxproc<(!fir.ref<i32>) -> i32>29!CHECK: omp.private {type = private} @_QFFtest_privateEps_private_boxproc__args_ref_i32 : !fir.boxproc<(!fir.ref<i32>) -> ()>30!CHECK: omp.private {type = private} @_QFFtest_privateEpf_private_boxproc_i32_args_ref_i32 : !fir.boxproc<(!fir.ref<i32>) -> i32>31 32!CHECK-LABEL: func private @_QFPtest_private33!CHECK: %[[PF:.*]]:2 = hlfir.declare %{{.*}} {{{.*}}uniq_name = "_QFFtest_privateEpf"}34!CHECK: %[[PS:.*]]:2 = hlfir.declare %{{.*}} {{{.*}}uniq_name = "_QFFtest_privateEps"}35!CHECK: omp.parallel36!CHECK: %[[PRIV_PF:.*]]:2 = hlfir.declare %{{.*}} {{{.*}}uniq_name = "_QFFtest_privateEpf"}37!CHECK: %[[PRIV_PS:.*]]:2 = hlfir.declare %{{.*}} {{{.*}}uniq_name = "_QFFtest_privateEps"}38!CHECK: %[[PF_VAL:.*]] = fir.load %[[PRIV_PF]]#039!CHECK: %[[PF_BOX:.*]] = fir.box_addr %[[PF_VAL]]40!CHECK: fir.call %[[PF_BOX]]({{.*}})41!CHECK: %[[PS_VAL:.*]] = fir.load %[[PRIV_PS]]#042!CHECK: %[[PS_BOX:.*]] = fir.box_addr %[[PS_VAL]]43!CHECK: fir.call %[[PS_BOX]]({{.*}})44subroutine test_private45 procedure(f), pointer :: pf46 procedure(sub), pointer :: ps47 integer :: res48 49 !$omp parallel private(pf, ps)50 pf => f51 ps => sub52 res = pf(123)53 call ps(456)54 !$omp end parallel55end subroutine56 57!CHECK-LABEL: func private @_QFPtest_firstprivate58!CHECK: %[[PF:.*]]:2 = hlfir.declare %{{.*}} {{{.*}}uniq_name = "_QFFtest_firstprivateEpf"}59!CHECK: %[[PS:.*]]:2 = hlfir.declare %{{.*}} {{{.*}}uniq_name = "_QFFtest_firstprivateEps"}60!CHECK: omp.parallel61!CHECK: %[[PRIV_PF:.*]]:2 = hlfir.declare %{{.*}} {{{.*}}uniq_name = "_QFFtest_firstprivateEpf"}62!CHECK: %[[PRIV_PS:.*]]:2 = hlfir.declare %{{.*}} {{{.*}}uniq_name = "_QFFtest_firstprivateEps"}63subroutine test_firstprivate64 procedure(f), pointer :: pf65 procedure(sub), pointer :: ps66 67 !$omp parallel firstprivate(pf, ps)68 !$omp end parallel69end subroutine70 71!CHECK-LABEL: func private @_QFPtest_lastprivate72!CHECK: %[[PF:.*]]:2 = hlfir.declare %{{.*}} {{{.*}}uniq_name = "_QFFtest_lastprivateEpf"}73!CHECK: %[[PS:.*]]:2 = hlfir.declare %{{.*}} {{{.*}}uniq_name = "_QFFtest_lastprivateEps"}74!CHECK: omp.parallel75!CHECK: %[[PRIV_PF:.*]]:2 = hlfir.declare %{{.*}} {{{.*}}uniq_name = "_QFFtest_lastprivateEpf"}76!CHECK: %[[PRIV_PS:.*]]:2 = hlfir.declare %{{.*}} {{{.*}}uniq_name = "_QFFtest_lastprivateEps"}77!CHECK: %[[PF_VAL:.*]] = fir.load %[[PRIV_PF]]#078!CHECK: fir.store %[[PF_VAL]] to %[[PF]]#079!CHECK: %[[PS_VAL:.*]] = fir.load %[[PRIV_PS]]#080!CHECK: fir.store %[[PS_VAL]] to %[[PS]]#081subroutine test_lastprivate82 procedure(f), pointer :: pf83 procedure(sub), pointer :: ps84 integer :: i85 86 !$omp parallel do lastprivate(pf, ps)87 do i = 1, 588 end do89 !$omp end parallel do90end subroutine91 92!CHECK-LABEL: func private @_QFPtest_sections93!CHECK: %[[PF:.*]]:2 = hlfir.declare %{{.*}} {{{.*}}uniq_name = "_QFFtest_sectionsEpf"}94!CHECK: %[[PS:.*]]:2 = hlfir.declare %{{.*}} {{{.*}}uniq_name = "_QFFtest_sectionsEps"}95!CHECK: %[[PRIV_PF:.*]]:2 = hlfir.declare %{{.*}} {{{.*}}uniq_name = "_QFFtest_sectionsEpf"}96!CHECK: %[[PF_VAL:.*]] = fir.load %[[PF]]#097!CHECK: fir.store %[[PF_VAL]] to %[[PRIV_PF]]#098!CHECK: %[[PRIV_PS:.*]]:2 = hlfir.declare %{{.*}} {{{.*}}uniq_name = "_QFFtest_sectionsEps"}99!CHECK: %[[PS_VAL:.*]] = fir.load %[[PS]]#0100!CHECK: fir.store %[[PS_VAL]] to %[[PRIV_PS]]#0101!CHECK: omp.sections102!CHECK: %[[PF_VAL:.*]] = fir.load %[[PRIV_PF]]#0103!CHECK: fir.store %[[PF_VAL]] to %[[PF]]#0104!CHECK: %[[PS_VAL:.*]] = fir.load %[[PRIV_PS]]#0105!CHECK: fir.store %[[PS_VAL]] to %[[PS]]#0106subroutine test_sections107 procedure(f), pointer :: pf108 procedure(sub), pointer :: ps109 110 !$omp sections firstprivate(pf, ps) lastprivate(pf, ps)111 !$omp end sections112end subroutine113 114integer function f(arg)115 integer :: arg116 f = arg117end function118 119subroutine sub(arg)120 integer :: arg121end subroutine122 123subroutine test_names124 procedure(s0), pointer :: ps0125 procedure(s1), pointer :: ps1126 procedure(s2), pointer :: ps2127 128 procedure(f0), pointer :: pf0129 procedure(f1), pointer :: pf1130 procedure(f2), pointer :: pf2131 132 !$omp parallel private(ps0, ps1, ps2, pf0, pf1, pf2)133 !$omp end parallel134end subroutine135 136subroutine s0137end subroutine138 139subroutine s1(i)140 integer :: i141end subroutine142 143subroutine s2(i, j)144 integer :: i145 character(*) :: j146end subroutine147 148integer function f0149 f0 = 0150end function151 152real function f1(r)153 real :: r154 155 f1 = 0.0156end function157 158function f2(a, c)159 real :: a(3, 4)160 complex :: f2, c161 162 f2 = (0.0, 0.0)163end function164 165end program166