1! Test that derived type allocatable members of private copies are properly 2! initialized. 3!RUN: %flang_fc1 -emit-hlfir -fopenmp %s -o - | FileCheck %s 4 5module m1 6 type x 7 integer, allocatable :: x1(:) 8 end type 9 10 type y 11 integer :: y1(10) 12 end type 13 14contains 15 16!CHECK-LABEL: omp.private {type = private} @_QMm1Ftest_pointer 17!CHECK-NOT: fir.call @_FortranAInitializeClone 18!CHECK: omp.yield 19 20!CHECK-LABEL: omp.private {type = private} @_QMm1Ftest_nested 21!CHECK: fir.call @_FortranAInitializeClone 22!CHECK-NEXT: omp.yield 23 24!CHECK-LABEL: omp.private {type = private} @_QMm1Ftest_array_of_allocs 25!CHECK: fir.call @_FortranAInitializeClone 26!CHECK-NEXT: omp.yield 27!CHECK: } dealloc { 28!CHECK: fir.call @_FortranAAllocatableDeallocate 29!CHECK: omp.yield 30 31!CHECK-LABEL: omp.private {type = firstprivate} @_QMm1Ftest_array 32!CHECK-NOT: fir.call @_FortranAInitializeClone 33!CHECK: omp.yield 34 35!CHECK-LABEL: omp.private {type = private} @_QMm1Ftest_array 36!CHECK: fir.call @_FortranAInitializeClone 37!CHECK-NEXT: omp.yield 38 39!CHECK-LABEL: omp.private {type = private} @_QMm1Ftest_scalar 40!CHECK: fir.call @_FortranAInitializeClone 41!CHECK-NEXT: omp.yield 42 43 subroutine test_scalar() 44 type(x) :: v 45 allocate(v%x1(5)) 46 47 !$omp parallel private(v) 48 !$omp end parallel 49 end subroutine 50 51! Test omp sections lastprivate(v, v2) 52! - InitializeClone must not be called for v2, that doesn't have an 53! allocatable member. 54! - InitializeClone must be called for v, that has an allocatable member. 55! - To avoid race conditions between InitializeClone and lastprivate, a 56! barrier must be present after the initializations. 57!CHECK-LABEL: func @_QMm1Ptest_array 58!CHECK: fir.call @_FortranAInitializeClone 59!CHECK-NEXT: omp.barrier 60 subroutine test_array() 61 type(x) :: v(10) 62 type(y) :: v2(10) 63 allocate(v(1)%x1(5)) 64 65 !$omp parallel private(v) 66 !$omp end parallel 67 68 !$omp parallel 69 !$omp sections lastprivate(v2, v) 70 !$omp end sections 71 !$omp end parallel 72 73 !$omp parallel firstprivate(v) 74 !$omp end parallel 75 end subroutine 76 77 subroutine test_array_of_allocs() 78 type(x), allocatable :: v(:) 79 allocate(v(10)) 80 allocate(v(1)%x1(5)) 81 82 !$omp parallel private(v) 83 !$omp end parallel 84 end subroutine 85 86 subroutine test_nested() 87 type dt1 88 integer, allocatable :: a(:) 89 end type 90 91 type dt2 92 type(dt1) :: d1 93 end type 94 95 type(dt2) :: d2 96 allocate(d2%d1%a(10)) 97 98 !$omp parallel private(d2) 99 !$omp end parallel 100 end subroutine 101 102 subroutine test_pointer() 103 type(x), pointer :: ptr 104 105 !$omp parallel private(ptr) 106 !$omp end parallel 107 end subroutine 108end module 109