167204Sobrien! { dg-do run }
267204Sobrien!
3156813Sru! CO_BROADCAST
4156813Sru!
5125634Sgrehanprogram test
6174930Smarcel  implicit none
767204Sobrien  intrinsic co_broadcast
883368Sru
967204Sobrien  type t
10125634Sgrehan    integer :: i
11123375Sgrehan    character(len=1) :: c
12123375Sgrehan    real(8) :: x(3), y(3)
1368548Sbenno  end type t
14123375Sgrehan
15123375Sgrehan  integer :: i, j(10), stat
16123375Sgrehan  complex :: a(5,5)
1768548Sbenno  character(kind=1, len=5) :: str1, errstr
18123375Sgrehan  character(kind=4, len=8) :: str2(2)
19123375Sgrehan  type(t) :: dt(4)
20123375Sgrehan
21123375Sgrehan  i = 1
2267204Sobrien  j = 55
23125634Sgrehan  a = 99.0
2467204Sobrien  str1 = 1_"XXXXX"
2568548Sbenno  str2 = 4_"YYYYYYYY"
26123375Sgrehan  dt = t(1, 'C', [1.,2.,3.], [3,3,3])
27123375Sgrehan  errstr = "ZZZZZ"
28123375Sgrehan
29123375Sgrehan  if (this_image() == num_images()) then
30123375Sgrehan    i = 2
31123375Sgrehan    j = 66
32123375Sgrehan    a = -99.0
33123375Sgrehan    str1 = 1_"abcd"
34123375Sgrehan    str2 = 4_"12 3 4 5"
35125634Sgrehan    dt = t(-1, 'a', [3.,1.,8.], [99,24,5])
36125634Sgrehan  end if
37125634Sgrehan  sync all
38125634Sgrehan
39125634Sgrehan  call co_broadcast(i, source_image=num_images(), stat=stat, errmsg=errstr)
40125634Sgrehan  if (stat /= 0) call abort()
41125634Sgrehan  if (errstr /= "ZZZZZ") call abort()
4268548Sbenno  if (i /= 2) call abort()
4368548Sbenno
44123375Sgrehan  call co_broadcast(j, source_image=num_images(), stat=stat, errmsg=errstr)
45123375Sgrehan  if (stat /= 0) call abort()
46123375Sgrehan  if (errstr /= "ZZZZZ") call abort()
47123375Sgrehan  if (any (j /= 66)) call abort
48123375Sgrehan
49123375Sgrehan  call co_broadcast(a, source_image=num_images(), stat=stat, errmsg=errstr)
5067204Sobrien  if (stat /= 0) call abort()
51156813Sru  if (errstr /= "ZZZZZ") call abort()
52123375Sgrehan  if (any (a /= -99.0)) call abort
53123375Sgrehan
54123375Sgrehan  call co_broadcast(str1, source_image=num_images(), stat=stat, errmsg=errstr)
55123375Sgrehan  if (stat /= 0) call abort()
56123375Sgrehan  if (errstr /= "ZZZZZ") call abort()
5767204Sobrien  if (str1 /= "abcd") call abort()
58125634Sgrehan
5968548Sbenno  call co_broadcast(str2, source_image=num_images(), stat=stat, errmsg=errstr)
60125634Sgrehan  if (stat /= 0) call abort()
6168548Sbenno  if (errstr /= "ZZZZZ") call abort()
62125634Sgrehan  if (any (str2 /= 4_"12 3 4 5")) call abort
6367204Sobrien
64125634Sgrehan  call co_broadcast(dt, source_image=num_images(), stat=stat, errmsg=errstr)
6567204Sobrien  if (stat /= 0) call abort()
66123375Sgrehan  if (errstr /= "ZZZZZ") call abort()
67131811Sgrehan  if (any (dt(:)%i /= -1)) call abort()
68123375Sgrehan  if (any (dt(:)%c /= 'a')) call abort()
69123375Sgrehan  if (any (dt(:)%x(1) /= 3.)) call abort()
7067204Sobrien  if (any (dt(:)%x(2) /= 1.)) call abort()
71131811Sgrehan  if (any (dt(:)%x(3) /= 8.)) call abort()
72131811Sgrehan  if (any (dt(:)%y(1) /= 99.)) call abort()
73132997Sgrehan  if (any (dt(:)%y(2) /= 24.)) call abort()
74132997Sgrehan  if (any (dt(:)%y(3) /= 5.)) call abort()
75132997Sgrehan
76123375Sgrehan  sync all
77123375Sgrehan  dt = t(1, 'C', [1.,2.,3.], [3,3,3])
78125634Sgrehan  sync all
79123375Sgrehan  if (this_image() == num_images()) then
80133862Smarius    str2 = 4_"001122"
8167204Sobrien    dt(2:4) = t(-2, 'i', [9.,2.,3.], [4,44,321])
8267204Sobrien  end if
8367204Sobrien
8467204Sobrien  call co_broadcast(str2(::2), source_image=num_images(), stat=stat, &
8567204Sobrien                    errmsg=errstr)
8667204Sobrien  if (stat /= 0) call abort()
87125634Sgrehan  if (errstr /= "ZZZZZ") call abort()
88125634Sgrehan  if (str2(1) /= 4_"001122") call abort()
8967204Sobrien  if (this_image() == num_images()) then
90123375Sgrehan    if (str2(1) /= 4_"001122") call abort()
9167204Sobrien  else
9267204Sobrien    if (str2(2) /= 4_"12 3 4 5") call abort()
93125634Sgrehan  end if
94123375Sgrehan
95123375Sgrehan  call co_broadcast(dt(2::2), source_image=num_images(), stat=stat, &
9667204Sobrien                    errmsg=errstr)
97123375Sgrehan  if (stat /= 0) call abort()
98125634Sgrehan  if (errstr /= "ZZZZZ") call abort()
99123375Sgrehan  if (this_image() == num_images()) then
100123375Sgrehan    if (any (dt(1:1)%i /= 1)) call abort()
10167204Sobrien    if (any (dt(1:1)%c /= 'C')) call abort()
102123375Sgrehan    if (any (dt(1:1)%x(1) /= 1.)) call abort()
10367204Sobrien    if (any (dt(1:1)%x(2) /= 2.)) call abort()
10467204Sobrien    if (any (dt(1:1)%x(3) /= 3.)) call abort()
10567204Sobrien    if (any (dt(1:1)%y(1) /= 3.)) call abort()
106    if (any (dt(1:1)%y(2) /= 3.)) call abort()
107    if (any (dt(1:1)%y(3) /= 3.)) call abort()
108
109    if (any (dt(2:)%i /= -2)) call abort()
110    if (any (dt(2:)%c /= 'i')) call abort()
111    if (any (dt(2:)%x(1) /= 9.)) call abort()
112    if (any (dt(2:)%x(2) /= 2.)) call abort()
113    if (any (dt(2:)%x(3) /= 3.)) call abort()
114    if (any (dt(2:)%y(1) /= 4.)) call abort()
115    if (any (dt(2:)%y(2) /= 44.)) call abort()
116    if (any (dt(2:)%y(3) /= 321.)) call abort()
117  else
118    if (any (dt(1::2)%i /= 1)) call abort()
119    if (any (dt(1::2)%c /= 'C')) call abort()
120    if (any (dt(1::2)%x(1) /= 1.)) call abort()
121    if (any (dt(1::2)%x(2) /= 2.)) call abort()
122    if (any (dt(1::2)%x(3) /= 3.)) call abort()
123    if (any (dt(1::2)%y(1) /= 3.)) call abort()
124    if (any (dt(1::2)%y(2) /= 3.)) call abort()
125    if (any (dt(1::2)%y(3) /= 3.)) call abort()
126
127    if (any (dt(2::2)%i /= -2)) call abort()
128    if (any (dt(2::2)%c /= 'i')) call abort()
129    if (any (dt(2::2)%x(1) /= 9.)) call abort()
130    if (any (dt(2::2)%x(2) /= 2.)) call abort()
131    if (any (dt(2::2)%x(3) /= 3.)) call abort()
132    if (any (dt(2::2)%y(1) /= 4.)) call abort()
133    if (any (dt(2::2)%y(2) /= 44.)) call abort()
134    if (any (dt(2::2)%y(3) /= 321.)) call abort()
135  endif
136end program test
137