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 omp_lib
15  implicit none
16  class(*), allocatable :: B(:)
17
18 allocate(B, source=["abcdef","cdefi2"])
19 allocate(B, source=[1,2,3])
20 call sub(B)
21contains
22  subroutine sub(val2)
23    class(*), allocatable :: val2(:)
24
25    !$OMP PARALLEL firstprivate(val2)  ! { dg-error "Sorry, polymorphic arrays not yet supported for firstprivate" }
26      if (.not.allocated(val2)) stop 3
27      select type (val2)
28        type is (character(len=*))
29          if (len(val2) /= 6) stop 44
30          if (val2(1) /= "abcdef" .or. val2(2) /= "cdefi2") stop 4545
31          val2 = ["123456", "789ABC"]
32        class default
33          stop 991
34      end select
35      select type (val2)
36        type is (character(len=*))
37          if (len(val2) /= 6) stop 44
38          if (val2(1) /= "123456" .or. val2(2) /= "789ABC") stop 453
39        class default
40          stop 991
41      end select
42    !$OMP END PARALLEL
43
44    if (.not.allocated(val2)) stop 3
45    select type (val2)
46      type is (character(len=*))
47        if (len(val2) /= 6) stop 44
48        if (val2(1) /= "abcdef" .or. val2(2) /= "cdefi2") stop 456
49      class default
50        stop 991
51    end select
52    print *, "PASS!"
53  end subroutine
54end program select_type_openmp
55