1! This test checks lowering of OpenMP Threadprivate Directive. 2! Test for real, logical, complex, and derived type. 3 4!RUN: %flang_fc1 -emit-hlfir -fopenmp %s -o - | FileCheck %s 5 6module test 7 type my_type 8 integer :: t_i 9 real :: t_arr(5) 10 end type my_type 11 real :: x 12 complex :: y 13 logical :: z 14 type(my_type) :: t 15 16 !$omp threadprivate(x, y, z, t) 17 18!CHECK-DAG: fir.global @_QMtestEt : !fir.type<_QMtestTmy_type{t_i:i32,t_arr:!fir.array<5xf32>}> { 19!CHECK-DAG: fir.global @_QMtestEx : f32 { 20!CHECK-DAG: fir.global @_QMtestEy : complex<f32> { 21!CHECK-DAG: fir.global @_QMtestEz : !fir.logical<4> { 22 23contains 24!CHECK-LABEL: func.func @_QMtestPsub 25 subroutine sub() 26!CHECK-DAG: %[[T:.*]] = fir.address_of(@_QMtestEt) : !fir.ref<!fir.type<_QMtestTmy_type{t_i:i32,t_arr:!fir.array<5xf32>}>> 27!CHECK-DAG: %[[T_DECL:.*]]:2 = hlfir.declare %[[T]] {uniq_name = "_QMtestEt"} : (!fir.ref<!fir.type<_QMtestTmy_type{t_i:i32,t_arr:!fir.array<5xf32>}>>) -> (!fir.ref<!fir.type<_QMtestTmy_type{t_i:i32,t_arr:!fir.array<5xf32>}>>, !fir.ref<!fir.type<_QMtestTmy_type{t_i:i32,t_arr:!fir.array<5xf32>}>>) 28!CHECK-DAG: %[[OMP_T:.*]] = omp.threadprivate %[[T_DECL]]#1 : !fir.ref<!fir.type<_QMtestTmy_type{t_i:i32,t_arr:!fir.array<5xf32>}>> -> !fir.ref<!fir.type<_QMtestTmy_type{t_i:i32,t_arr:!fir.array<5xf32>}>> 29!CHECK-DAG: %[[OMP_T_DECL:.*]]:2 = hlfir.declare %[[OMP_T]] {uniq_name = "_QMtestEt"} : (!fir.ref<!fir.type<_QMtestTmy_type{t_i:i32,t_arr:!fir.array<5xf32>}>>) -> (!fir.ref<!fir.type<_QMtestTmy_type{t_i:i32,t_arr:!fir.array<5xf32>}>>, !fir.ref<!fir.type<_QMtestTmy_type{t_i:i32,t_arr:!fir.array<5xf32>}>>) 30!CHECK-DAG: %[[X:.*]] = fir.address_of(@_QMtestEx) : !fir.ref<f32> 31!CHECK-DAG: %[[X_DECL:.*]]:2 = hlfir.declare %[[X]] {uniq_name = "_QMtestEx"} : (!fir.ref<f32>) -> (!fir.ref<f32>, !fir.ref<f32>) 32!CHECK-DAG: %[[OMP_X:.*]] = omp.threadprivate %[[X_DECL]]#1 : !fir.ref<f32> -> !fir.ref<f32> 33!CHECK-DAG: %[[OMP_X_DECL:.*]]:2 = hlfir.declare %[[OMP_X]] {uniq_name = "_QMtestEx"} : (!fir.ref<f32>) -> (!fir.ref<f32>, !fir.ref<f32>) 34!CHECK-DAG: %[[Y:.*]] = fir.address_of(@_QMtestEy) : !fir.ref<complex<f32>> 35!CHECK-DAG: %[[Y_DECL:.*]]:2 = hlfir.declare %[[Y]] {uniq_name = "_QMtestEy"} : (!fir.ref<complex<f32>>) -> (!fir.ref<complex<f32>>, !fir.ref<complex<f32>>) 36!CHECK-DAG: %[[OMP_Y:.*]] = omp.threadprivate %[[Y_DECL]]#1 : !fir.ref<complex<f32>> -> !fir.ref<complex<f32>> 37!CHECK-DAG: %[[OMP_Y_DECL:.*]]:2 = hlfir.declare %[[OMP_Y]] {uniq_name = "_QMtestEy"} : (!fir.ref<complex<f32>>) -> (!fir.ref<complex<f32>>, !fir.ref<complex<f32>>) 38!CHECK-DAG: %[[Z:.*]] = fir.address_of(@_QMtestEz) : !fir.ref<!fir.logical<4>> 39!CHECK-DAG: %[[Z_DECL:.*]]:2 = hlfir.declare %[[Z]] {uniq_name = "_QMtestEz"} : (!fir.ref<!fir.logical<4>>) -> (!fir.ref<!fir.logical<4>>, !fir.ref<!fir.logical<4>>) 40!CHECK-DAG: %[[OMP_Z:.*]] = omp.threadprivate %[[Z_DECL]]#1 : !fir.ref<!fir.logical<4>> -> !fir.ref<!fir.logical<4>> 41!CHECK-DAG: %[[OMP_Z_DECL:.*]]:2 = hlfir.declare %[[OMP_Z]] {uniq_name = "_QMtestEz"} : (!fir.ref<!fir.logical<4>>) -> (!fir.ref<!fir.logical<4>>, !fir.ref<!fir.logical<4>>) 42!CHECK-DAG: %{{.*}} = fir.load %[[OMP_X_DECL]]#0 : !fir.ref<f32> 43!CHECK-DAG: %{{.*}} = fir.load %[[OMP_Y_DECL]]#0 : !fir.ref<complex<f32>> 44!CHECK-DAG: %{{.*}} = fir.load %[[OMP_Z_DECL]]#0 : !fir.ref<!fir.logical<4>> 45!CHECK-DAG: %{{.*}} = hlfir.designate %[[OMP_T_DECL]]#0{"t_i"} : (!fir.ref<!fir.type<_QMtestTmy_type{t_i:i32,t_arr:!fir.array<5xf32>}>>) -> !fir.ref<i32> 46 print *, x, y, z, t%t_i 47 48 !$omp parallel 49!CHECK-DAG: %[[T_PVT:.*]] = omp.threadprivate %[[T_DECL]]#1 : !fir.ref<!fir.type<_QMtestTmy_type{t_i:i32,t_arr:!fir.array<5xf32>}>> -> !fir.ref<!fir.type<_QMtestTmy_type{t_i:i32,t_arr:!fir.array<5xf32>}>> 50!CHECK-DAG: %[[T_PVT_DECL:.*]]:2 = hlfir.declare %[[T_PVT]] {uniq_name = "_QMtestEt"} : (!fir.ref<!fir.type<_QMtestTmy_type{t_i:i32,t_arr:!fir.array<5xf32>}>>) -> (!fir.ref<!fir.type<_QMtestTmy_type{t_i:i32,t_arr:!fir.array<5xf32>}>>, !fir.ref<!fir.type<_QMtestTmy_type{t_i:i32,t_arr:!fir.array<5xf32>}>>) 51!CHECK-DAG: %[[X_PVT:.*]] = omp.threadprivate %[[X_DECL]]#1 : !fir.ref<f32> -> !fir.ref<f32> 52!CHECK-DAG: %[[X_PVT_DECL:.*]]:2 = hlfir.declare %[[X_PVT]] {uniq_name = "_QMtestEx"} : (!fir.ref<f32>) -> (!fir.ref<f32>, !fir.ref<f32>) 53!CHECK-DAG: %[[Y_PVT:.*]] = omp.threadprivate %[[Y_DECL]]#1 : !fir.ref<complex<f32>> -> !fir.ref<complex<f32>> 54!CHECK-DAG: %[[Y_PVT_DECL:.*]]:2 = hlfir.declare %[[Y_PVT]] {uniq_name = "_QMtestEy"} : (!fir.ref<complex<f32>>) -> (!fir.ref<complex<f32>>, !fir.ref<complex<f32>>) 55!CHECK-DAG: %[[Z_PVT:.*]] = omp.threadprivate %[[Z_DECL]]#1 : !fir.ref<!fir.logical<4>> -> !fir.ref<!fir.logical<4>> 56!CHECK-DAG: %[[Z_PVT_DECL:.*]]:2 = hlfir.declare %[[Z_PVT]] {uniq_name = "_QMtestEz"} : (!fir.ref<!fir.logical<4>>) -> (!fir.ref<!fir.logical<4>>, !fir.ref<!fir.logical<4>>) 57!CHECK-DAG: %{{.*}} = fir.load %[[X_PVT_DECL]]#0 : !fir.ref<f32> 58!CHECK-DAG: %{{.*}} = fir.load %[[Y_PVT_DECL]]#0 : !fir.ref<complex<f32>> 59!CHECK-DAG: %{{.*}} = fir.load %[[Z_PVT_DECL]]#0 : !fir.ref<!fir.logical<4>> 60!CHECK-DAG: %{{.*}} = hlfir.designate %[[T_PVT_DECL]]#0{"t_i"} : (!fir.ref<!fir.type<_QMtestTmy_type{t_i:i32,t_arr:!fir.array<5xf32>}>>) -> !fir.ref<i32> 61print *, x, y, z, t%t_i 62 !$omp end parallel 63!CHECK-DAG: %{{.*}} = fir.load %[[OMP_X_DECL]]#0 : !fir.ref<f32> 64!CHECK-DAG: %{{.*}} = fir.load %[[OMP_Y_DECL]]#0 : !fir.ref<complex<f32>> 65!CHECK-DAG: %{{.*}} = fir.load %[[OMP_Z_DECL]]#0 : !fir.ref<!fir.logical<4>> 66!CHECK-DAG: %{{.*}} = hlfir.designate %[[OMP_T_DECL]]#0{"t_i"} : (!fir.ref<!fir.type<_QMtestTmy_type{t_i:i32,t_arr:!fir.array<5xf32>}>>) -> !fir.ref<i32> 67 print *, x, y, z, t%t_i 68 69 end 70end 71