1! { dg-do run }
2! { dg-options "-fcoarray=single -Wzerotrip" }
3!
4! PR fortran/18918
5!
6! Contributed by John Reid.
7!
8program ex2
9      implicit none
10      real, allocatable :: z(:)[:]
11      integer :: image
12      character(len=128) :: str
13
14      allocate(z(3)[*])
15      write(*,*) 'z allocated on image',this_image()
16      sync all
17      if (this_image()==1) then
18          z = 1.2
19          do image = 2, num_images() ! { dg-warning "will be executed zero times" }
20            write(*,*) 'Assigning z(:) on image',image
21            z(:)[image] = z
22         end do
23      end if
24      sync all
25
26      str = repeat('X', len(str))
27      write(str,*) 'z=',z(:),' on image',this_image()
28      if (str /= " z=   1.20000005       1.20000005       1.20000005      on image           1") &
29        call abort
30
31      str = repeat('X', len(str))
32      write(str,*) 'z=',z,' on image',this_image()
33      if (str /= " z=   1.20000005       1.20000005       1.20000005      on image           1") &
34        call abort
35
36      str = repeat('X', len(str))
37      write(str,*) 'z=',z(1:3)[this_image()],' on image',this_image()
38      if (str /= " z=   1.20000005       1.20000005       1.20000005      on image           1") &
39        call abort
40
41      call ex2a()
42      call ex5()
43end
44
45subroutine ex2a()
46      implicit none
47      real, allocatable :: z(:,:)[:,:]
48      integer :: image
49      character(len=128) :: str
50
51      allocate(z(2,2)[1,*])
52      write(*,*) 'z allocated on image',this_image()
53      sync all
54      if (this_image()==1) then
55          z = 1.2
56          do image = 2, num_images() ! { dg-warning "will be executed zero times" }
57            write(*,*) 'Assigning z(:) on image',image
58            z(:,:)[1,image] = z
59         end do
60      end if
61      sync all
62
63      str = repeat('X', len(str))
64      write(str,*) 'z=',z(:,:),' on image',this_image()
65      if (str /= " z=   1.20000005       1.20000005       1.20000005       1.20000005      on image           1") &
66        call abort
67
68      str = repeat('X', len(str))
69      write(str,*) 'z=',z,' on image',this_image()
70      if (str /= " z=   1.20000005       1.20000005       1.20000005       1.20000005      on image           1") &
71        call abort
72end subroutine ex2a
73
74subroutine ex5
75   implicit none
76   integer :: me
77   real, save :: w(4)[*]
78   character(len=128) :: str
79
80   me = this_image()
81   w = me
82
83   str = repeat('X', len(str))
84   write(str,*) 'In main on image',this_image(), 'w= ',w
85   if (str /= " In main on image           1 w=    1.00000000       1.00000000       1.00000000       1.00000000") &
86        call abort
87
88   str = repeat('X', len(str))
89   write(str,*) 'In main on image',this_image(), 'w= ',w(1:4)
90   if (str /= " In main on image           1 w=    1.00000000       1.00000000       1.00000000       1.00000000") &
91        call abort
92
93   str = repeat('X', len(str))
94   write(str,*) 'In main on image',this_image(), 'w= ',w(:)[1]
95   if (str /= " In main on image           1 w=    1.00000000       1.00000000       1.00000000       1.00000000") &
96        call abort
97
98   sync all
99   call ex5_sub(me,w)
100end subroutine ex5
101
102subroutine ex5_sub(n,w)
103   implicit none
104   integer :: n
105   real :: w(n)
106   character(len=75) :: str
107
108   str = repeat('X', len(str))
109   write(str,*) 'In sub on image',this_image(), 'w= ',w
110   if (str /= " In sub on image           1 w=    1.00000000") &
111        call abort
112end subroutine ex5_sub
113