OSDN Git Service

2011-04-29 Jerry DeLisle <jvdelisle@gcc.gnu.org>
[pf3gnuchains/gcc-fork.git] / gcc / testsuite / gfortran.dg / coarray_15.f90
1 ! { dg-do run }
2 ! { dg-options "-fcoarray=single" }
3 !
4 ! PR fortran/18918
5 !
6 ! Contributed by John Reid.
7 !
8 program 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()
43 end
44
45 subroutine 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
72 end subroutine ex2a
73
74 subroutine 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)
100 end subroutine ex5
101       
102 subroutine 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
112 end subroutine ex5_sub