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