gcc/testsuite/gfortran.dg/coarray/image_index_2.f90

   1 ! { dg-do run }
   2 !
   3 ! Scalar coarray
   4 !
   5 ! Run-time test for IMAGE_INDEX with cobounds only known at
   6 ! the compile time, suitable for any number of NUM_IMAGES()
   7 ! For compile-time cobounds, the -fcoarray=lib version still
   8 ! needs to run-time evalulation if image_index returns > 1
   9 ! as image_index is 0 if the index would exceed num_images().
  10 !
  11 ! Please set num_images() to >= 13, if possible.
  12 !
  13 ! PR fortran/18918
  14 !
  15
  16 program test_image_index
  17 implicit none
  18 integer :: index1, index2, index3
  19 logical :: one
  20
  21 integer, save :: d[-1:3, *]
  22 integer, save :: e[-1:-1, 3:*]
  23
  24 one = num_images() == 1
  25
  26 index1 = image_index(d, [-1, 1] )
  27 index2 = image_index(d, [0, 1] )
  28
  29 if (one .and. (index1 /= 1 .or. index2 /= 0)) &
  30   call abort()
  31 if (.not. one .and. (index1 /= 1 .or. index2 /= 2)) &
  32   call abort()
  33
  34 index1 = image_index(e, [-1, 3] )
  35 index2 = image_index(e, [-1, 4] )
  36
  37 if (one .and. (index1 /= 1 .or. index2 /= 0)) &
  38   call abort()
  39 if (.not. one .and. (index1 /= 1 .or. index2 /= 2)) &
  40   call abort()
  41
  42 call test(1, e, d, e)
  43 call test(2, e, d, e)
  44
  45 contains
  46 subroutine test(n, a, b, c)
  47   integer :: n
  48   integer :: a[3*n:3*n, -4*n:-3*n, 88*n:*], b[-1*n:0*n,0*n:*], c[*]
  49
  50   index1 = image_index(a, [3*n, -4*n, 88*n] )
  51   index2 = image_index(b, [-1, 0] )
  52   index3 = image_index(c, [1] )
  53
  54   if (n == 1) then
  55     if (index1 /= 1 .or. index2 /= 1 .or. index3 /= 1) call abort()
  56   else if (num_images() == 1) then
  57     if (index1 /= 1 .or. index2 /= 0 .or. index3 /= 1) call abort()
  58   else
  59     if (index1 /= 1 .or. index2 /= 2 .or. index3 /= 1) call abort()
  60   end if
  61
  62   index1 = image_index(a, [3*n, -3*n, 88*n] )
  63   index2 = image_index(b, [0, 0] )
  64   index3 = image_index(c, [2] )
  65
  66   if (one .and. (index1 /= 0 .or. index2 /= 0 .or. index3 /= 0)) &
  67     call abort()
  68   if (n == 1 .and. num_images() == 2) then
  69     if (index1 /= 2 .or. index2 /= 2 .or. index3 /= 2) &
  70       call abort()
  71   else if (n == 2 .and. num_images() == 2) then
  72     if (index1 /= 0 .or. index2 /= 0 .or. index3 /= 2) &
  73       call abort()
  74   end if
  75 end subroutine test
  76 end program test_image_index