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