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  integer :: i
18  integer :: A(4)
19  type(c_ptr) :: B(4)
20
21  B = [(c_null_ptr, i=1,4)]
22  A = [1,2,3,4]
23  call sub(A, B)
24contains
25  subroutine sub(val1, val2)
26    class(*) :: val1(4)
27    type(c_ptr) :: val2(2:5)
28
29    !$OMP PARALLEL firstprivate(val2)
30      do i = 2, 5
31        if (c_associated (val2(i))) stop 123
32      end do
33    !$OMP END PARALLEL
34
35    !$OMP PARALLEL firstprivate(val1)  ! { dg-error "Sorry, polymorphic arrays not yet supported for firstprivate" }
36      select type (val1)
37        type is (integer)
38          if (size(val1) /= 4) stop 33
39          if (any (val1 /= [1, 2, 3, 4])) stop 4549
40          val1 = [32,6,48,28]
41        class default
42          stop 99
43      end select
44      select type (val1)
45        type is (integer)
46          if (size(val1) /= 4) stop 33
47          if (any (val1 /= [32,6,48,28])) stop 4512
48        class default
49          stop 99
50      end select
51    !$OMP END PARALLEL
52
53    select type (val1)
54      type is (integer)
55        if (size(val1) /= 4) stop 33
56        if (any (val1 /= [1, 2, 3, 4])) stop 454
57      class default
58        stop 99
59    end select
60    print *, "PASS!"
61  end subroutine
62end program select_type_openmp
63