1! { dg-do compile }
2! { dg-options "-fcoarray=single" }
3!
4! Check argument passing.
5! Taken from Reinhold Bader's fortran_tests.
6!
7
8module mod_rank_mismatch_02
9  implicit none
10  integer, parameter :: ndim = 2
11contains
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
30end module
31
32program 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
43  call subr(ndim, a(1,2)) ! { dg-error "must be simply contiguous" }
44                          ! See also F08/0048 and PR 45859 about the validity
45  if (this_image() == 1) then
46     write(*, *) 'OK'
47  end if
48end program
49