gcc/testsuite/gfortran.dg/array_alloc_2.f90

   1 ! Like array_alloc_1.f90, but check cases in which the array length is
   2 ! not a literal constant.
   3 ! { dg-do run }
   4 program main
   5   implicit none
   6   integer, parameter :: n = 100
   7   call test (n, f1 ())
   8   call test (47, f2 (50))
   9   call test (n, f3 (f1 ()))
  10 contains
  11   subroutine test (expected, x)
  12     integer, dimension (:) :: x
  13     integer :: i, expected
  14     if (size (x, 1) .ne. expected) call abort
  15     do i = 1, expected
  16       if (x (i) .ne. i * 100) call abort
  17     end do
  18   end subroutine test
  19
  20   function f1 ()
  21     integer, dimension (n) :: f1
  22     integer :: i
  23     forall (i = 1:n) f1 (i) = i * 100
  24   end function f1
  25
  26   function f2 (howmuch)
  27     integer :: i, howmuch
  28     integer, dimension (4:howmuch) :: f2
  29     forall (i = 4:howmuch) f2 (i) = i * 100 - 300
  30   end function f2
  31
  32   function f3 (x)
  33     integer, dimension (:) :: x
  34     integer, dimension (size (x, 1)) :: f3
  35     integer :: i
  36     forall (i = 1:size(x)) f3 (i) = i * 100
  37   end function f3
  38 end program main