gcc/testsuite/gfortran.dg/gomp/class-firstprivate-4.f90

! { dg-do compile }
! { dg-prune-output "compilation terminated." }
!
! FIRSTPRIVATE + class array
!
! For now: Expected to give "Sorry" for polymorphic arrays.
!
! Polymorphic arrays are tricky - at least if not allocatable, they become:
!   var.0 = var._data.data
! which needs to be handled properly.
!
!
program select_type_openmp
  use iso_c_binding
  !use omp_lib
  implicit none
  integer x(4)
  x = [1, 2, 3, 4]
  call sub(x)
  if (any (x /= [1,2,3,4])) stop 3
contains
  subroutine sub(val1)
    integer :: i
    class(*) :: val1(4)
 
    !$OMP PARALLEL firstprivate(val1)  ! { dg-error "Sorry, polymorphic arrays not yet supported for firstprivate" }
      select type (val1)
        type is (integer)
          if (size(val1) /= 4) stop 33
          if (any (val1 /= [1, 2, 3, 4])) stop 4549
          val1 = [32,6,48,28]
        class default
          stop 99
      end select
      select type (val1)
        type is (integer)
          if (size(val1) /= 4) stop 34
          if (any (val1 /= [32,6,48,28])) stop 4512
        class default
          stop 98
      end select
    !$OMP END PARALLEL
  end
end