gcc/testsuite/gfortran.fortran-torture/execute/arrayarg.f90

   1 ! Program to test arrays
   2 ! The program outputs a series of numbers.
   3 ! Two digit numbers beginning with 0, 1, 2 or 3 is a normal.
   4 ! Three digit numbers starting with 4 indicate an error.
   5 ! Using 1D arrays isn't a sufficient test, the first dimension is often
   6 ! handled specially.
   7
   8 ! Fixed size parameter
   9 subroutine f1 (a)
  10    implicit none
  11    integer, dimension (5, 8) :: a
  12
  13    if (a(1, 1) .ne. 42) call abort
  14
  15    if (a(5, 8) .ne. 43) call abort
  16 end subroutine
  17
  18
  19 program testprog
  20    implicit none
  21    integer, dimension(3:7, 4:11) :: a
  22    a(:,:) = 0
  23    a(3, 4) = 42
  24    a(7, 11) = 43
  25    call test(a)
  26 contains
  27 subroutine test (parm)
  28    implicit none
  29    ! parameter
  30    integer, dimension(2:, 3:) :: parm
  31    ! Known size arry
  32    integer, dimension(5, 8) :: a
  33    ! Known size array with different bounds
  34    integer, dimension(4:8, 3:10) :: b
  35    ! Unknown size arrays
  36    integer, dimension(:, :), allocatable :: c, d, e
  37    ! Vectors
  38    integer, dimension(5) :: v1
  39    integer, dimension(10, 10) :: v2
  40    integer n
  41    external f1
  42
  43    ! Same size
  44    allocate (c(5,8))
  45    ! Same size, different bounds
  46    allocate (d(11:15, 12:19))
  47    ! A larger array
  48    allocate (e(15, 24))
  49    a(:,:) = 0
  50    b(:,:) = 0
  51    c(:,:) = 0
  52    d(:,:) = 0
  53    a(1,1) = 42
  54    b(4, 3) = 42
  55    c(1,1) = 42
  56    d(11,12) = 42
  57    a(5, 8) = 43
  58    b(8, 10) = 43
  59    c(5, 8) = 43
  60    d(15, 19) = 43
  61
  62    v2(:, :) = 0
  63    do n=1,5
  64      v1(n) = n
  65    end do
  66
  67    v2 (3, 1::2) = v1 (5:1:-1)
  68    v1 = v1 + 1
  69
  70    if (v1(1) .ne. 2) call abort
  71    if (v2(3, 3) .ne. 4) call abort
  72
  73    ! Passing whole arrays
  74    call f1 (a)
  75    call f1 (b)
  76    call f1 (c)
  77    call f2 (a)
  78    call f2 (b)
  79    call f2 (c)
  80    ! passing expressions
  81    a(1,1) = 41
  82    a(5,8) = 42
  83    call f1(a+1)
  84    call f2(a+1)
  85    a(1,1) = 42
  86    a(5,8) = 43
  87    call f1 ((a + b) / 2)
  88    call f2 ((a + b) / 2)
  89    ! Passing whole arrays as sections
  90    call f1 (a(:,:))
  91    call f1 (b(:,:))
  92    call f1 (c(:,:))
  93    call f2 (a(:,:))
  94    call f2 (b(:,:))
  95    call f2 (c(:,:))
  96    ! Passing sections
  97    e(:,:) = 0
  98    e(2, 3) = 42
  99    e(6, 10) = 43
 100    n = 3
 101    call f1 (e(2:6, n:10))
 102    call f2 (e(2:6, n:10))
 103    ! Vector subscripts
 104    ! v1= index plus one, v2(3, ::2) = reverse of index
 105    e(:,:) = 0
 106    e(2, 3) = 42
 107    e(6, 10) = 43
 108    call f1 (e(v1, n:10))
 109    call f2 (e(v1, n:10))
 110    ! Double vector subscript
 111    e(:,:) = 0
 112    e(6, 3) = 42
 113    e(2, 10) = 43
 114    !These are not resolved properly
 115    call f1 (e(v1(v2(3, ::2)), n:10))
 116    call f2 (e(v1(v2(3, ::2)), n:10))
 117    ! non-contiguous sections
 118    e(:,:) = 0
 119    e(1, 1) = 42
 120    e(13, 22) = 43
 121    n = 3
 122    call f1 (e(1:15:3, 1:24:3))
 123    call f2 (e(::3, ::n))
 124    ! non-contiguous sections with bounds
 125    e(:,:) = 0
 126    e(3, 4) = 42
 127    e(11, 18) = 43
 128    n = 19
 129    call f1 (e(3:11:2, 4:n:2))
 130    call f2 (e(3:11:2, 4:n:2))
 131
 132    ! Passing a dummy variable
 133    call f1 (parm)
 134    call f2 (parm)
 135 end subroutine
 136 ! Assumed shape parameter
 137 subroutine f2 (a)
 138    integer, dimension (1:, 1:) :: a
 139
 140    if (a(1, 1) .ne. 42) call abort
 141
 142    if (a(5, 8) .ne. 43) call abort
 143 end subroutine
 144 end program
 145