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 x(4) 18 x = [1, 2, 3, 4] 19 call sub(x) 20 if (any (x /= [1,2,3,4])) stop 3 21contains 22 subroutine sub(val1) 23 integer :: i 24 class(*) :: val1(4) 25 26 !$OMP PARALLEL firstprivate(val1) ! { dg-error "Sorry, polymorphic arrays not yet supported for firstprivate" } 27 select type (val1) 28 type is (integer) 29 if (size(val1) /= 4) stop 33 30 if (any (val1 /= [1, 2, 3, 4])) stop 4549 31 val1 = [32,6,48,28] 32 class default 33 stop 99 34 end select 35 select type (val1) 36 type is (integer) 37 if (size(val1) /= 4) stop 34 38 if (any (val1 /= [32,6,48,28])) stop 4512 39 class default 40 stop 98 41 end select 42 !$OMP END PARALLEL 43 end 44end 45