gcc/testsuite/gfortran.dg/coarray_args_2.f90

   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
  43   call subr(ndim, a(1,2)) ! See also F08/0048 and PR 45859 about the validity
  44   if (this_image() == 1) then
  45      write(*, *) 'OK'
  46   end if
  47 end program