]>
Commit | Line | Data |
---|---|---|
394d3a2e TB |
1 | ! { dg-do compile } |
2 | ! { dg-options "-fcoarray=single" } | |
3 | ! | |
4 | ! Check argument passing. | |
5 | ! Taken from Reinhold Bader's fortran_tests. | |
6 | ! | |
7 | ||
8 | module mod_rank_mismatch_02 | |
9 | implicit none | |
10 | integer, parameter :: ndim = 2 | |
11 | contains | |
12 | subroutine subr(n,w) | |
13 | integer :: n | |
14 | real :: w(n,*)[*] | |
15 | ||
16 | integer :: k, x | |
17 | ||
18 | if (this_image() == 0) then | |
19 | x = 1.0 | |
20 | do k = 1, num_images() | |
21 | if (abs(w(2,1)[k] - x) > 1.0e-5) then | |
22 | write(*, *) 'FAIL' | |
23 | error stop | |
24 | end if | |
25 | x = x + 1.0 | |
26 | end do | |
27 | end if | |
28 | ||
29 | end subroutine | |
30 | end module | |
31 | ||
32 | program rank_mismatch_02 | |
33 | use mod_rank_mismatch_02 | |
34 | implicit none | |
35 | real :: a(ndim,2)[*] | |
36 | ||
37 | a = 0.0 | |
38 | a(2,2) = 1.0 * this_image() | |
39 | ||
40 | sync all | |
41 | ||
42 | call subr(ndim, a(1:1,2)) ! OK | |
460263d0 | 43 | call subr(ndim, a(1,2)) ! See also F08/0048 and PR 45859 about the validity |
394d3a2e TB |
44 | if (this_image() == 1) then |
45 | write(*, *) 'OK' | |
46 | end if | |
47 | end program |