1! { dg-do compile }
2! { dg-prune-output "compilation terminated." }
3!
4! FIRSTPRIVATE + class array
5!
6! For now: Expected to give "Sorry" for polymorphic arrays.
7!
8! Polymorphic arrays are tricky - at least if not allocatable, they become:
9!   var.0 = var._data.data
10! which needs to be handled properly.
11!
12!
13program select_type_openmp
14  use iso_c_binding
15  !use omp_lib
16  implicit none
17  call sub
18contains
19  subroutine sub
20    integer :: i
21    class(*), allocatable :: val1(:)
22    type(c_ptr), allocatable :: val2(:)
23
24    allocate(val1, source=[1, 2, 3, 4])
25    allocate(val2(2:5))
26    val2 = c_null_ptr
27
28    !$OMP PARALLEL firstprivate(val2)
29      do i = 2, 5
30        if (c_associated (val2(i))) stop 123
31      end do
32    !$OMP END PARALLEL
33
34    !$OMP PARALLEL firstprivate(val1)  ! { dg-error "Sorry, polymorphic arrays not yet supported for firstprivate" }
35      select type (val1)
36        type is (integer)
37          if (size(val1) /= 4) stop 33
38          if (any (val1 /= [1, 2, 3, 4])) stop 4549
39          val1 = [32,6,48,28]
40        class default
41          stop 99
42      end select
43      select type (val1)
44        type is (integer)
45          if (size(val1) /= 4) stop 33
46          if (any (val1 /= [32,6,48,28])) stop 4512
47        class default
48          stop 99
49      end select
50    !$OMP END PARALLEL
51
52    select type (val1)
53      type is (integer)
54        if (size(val1) /= 4) stop 33
55        if (any (val1 /= [1, 2, 3, 4])) stop 454
56      class default
57        stop 99
58    end select
59    print *, "PASS!"
60  end subroutine
61end program select_type_openmp
62