gcc/testsuite/gfortran.dg/allocatable_dummy_1.f90

   1 ! { dg-do run }
   2 ! Test procedures with allocatable dummy arguments
   3 program alloc_dummy
   4
   5     implicit none
   6     integer, allocatable :: a(:)
   7     integer, allocatable :: b(:)
   8
   9     call init(a)
  10     if (.NOT.allocated(a)) STOP 1
  11     if (.NOT.all(a == [ 1, 2, 3 ])) STOP 2
  12
  13     call useit(a, b)
  14     if (.NOT.all(b == [ 1, 2, 3 ])) STOP 3
  15
  16     if (.NOT.all(whatever(a) == [ 1, 2, 3 ])) STOP 4
  17
  18     call kill(a)
  19     if (allocated(a)) STOP 5
  20
  21     call kill(b)
  22     if (allocated(b)) STOP 6
  23
  24 contains
  25
  26     subroutine init(x)
  27         integer, allocatable, intent(out) :: x(:)
  28         allocate(x(3))
  29         x = [ 1, 2, 3 ]
  30     end subroutine init
  31
  32     subroutine useit(x, y)
  33         integer, allocatable, intent(in)  :: x(:)
  34         integer, allocatable, intent(out) :: y(:)
  35         if (allocated(y)) STOP 7
  36         call init(y)
  37         y = x
  38     end subroutine useit
  39
  40     function whatever(x)
  41         integer, allocatable :: x(:)
  42         integer :: whatever(size(x))
  43
  44         whatever = x
  45     end function whatever
  46
  47     subroutine kill(x)
  48         integer, allocatable, intent(out) :: x(:)
  49     end subroutine kill
  50
  51 end program alloc_dummy