1! { dg-do compile }
2!
3! PR fortran/32467
4! Derived types with allocatable components
5!
6
7MODULE test_allocatable_components
8  type :: t
9    integer, allocatable :: a(:)
10  end type
11
12CONTAINS
13  SUBROUTINE test_copyin()
14    TYPE(t), SAVE :: a
15
16    !$omp threadprivate(a)
17    !$omp parallel copyin(a)
18      ! do something
19    !$omp end parallel
20  END SUBROUTINE
21
22  SUBROUTINE test_copyprivate()
23    TYPE(t) :: a
24
25    !$omp single
26      ! do something
27    !$omp end single copyprivate (a)
28  END SUBROUTINE
29
30  SUBROUTINE test_firstprivate
31    TYPE(t) :: a
32
33    !$omp parallel firstprivate(a)
34      ! do something
35    !$omp end parallel
36  END SUBROUTINE
37
38  SUBROUTINE test_lastprivate
39    TYPE(t) :: a
40    INTEGER :: i
41
42    !$omp parallel do lastprivate(a)
43      DO i = 1, 1
44      END DO
45    !$omp end parallel do
46  END SUBROUTINE
47
48  SUBROUTINE test_reduction
49    TYPE(t) :: a(10)
50    INTEGER :: i
51
52    !$omp parallel do reduction(+: a)   ! { dg-error "OMP DECLARE REDUCTION\[^\n\r\]*not found for type" }
53    DO i = 1, SIZE(a)
54    END DO
55    !$omp end parallel do
56  END SUBROUTINE
57END MODULE
58