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

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