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