Subversion Repositories openrisc

! { dg-do compile }

! { dg-options "-fcoarray=single" }

!

! Check argument passing.

! Taken from Reinhold Bader's fortran_tests.

!

module mod_rank_mismatch_02

  implicit none

  integer, parameter :: ndim = 2

contains

  subroutine subr(n,w)

    integer :: n

    real :: w(n,*)[*]

    integer :: k, x

    if (this_image() == 0) then

       x = 1.0

       do k = 1, num_images()

           if (abs(w(2,1)[k] - x) > 1.0e-5) then

              write(*, *) 'FAIL'

              error stop

           end if

           x = x + 1.0

       end do

    end if

  end subroutine

end module

program rank_mismatch_02

  use mod_rank_mismatch_02

  implicit none

  real :: a(ndim,2)[*]

  a = 0.0

  a(2,2) = 1.0 * this_image()

  sync all

  call subr(ndim, a(1:1,2)) ! OK

  call subr(ndim, a(1,2)) ! { dg-error "must be simply contiguous" }

                          ! See also F08/0048 and PR 45859 about the validity

  if (this_image() == 1) then

     write(*, *) 'OK'

  end if

end program

! { dg-final { cleanup-modules "mod_rank_mismatch_02" } }