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)) call abort()
  11     if (.NOT.all(a == [ 1, 2, 3 ])) call abort()
  12
  13     call useit(a, b)
  14     if (.NOT.all(b == [ 1, 2, 3 ])) call abort()
  15
  16     if (.NOT.all(whatever(a) == [ 1, 2, 3 ])) call abort()
  17
  18     call kill(a)
  19     if (allocated(a)) call abort()
  20
  21     call kill(b)
  22     if (allocated(b)) call abort()
  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)) call abort()
  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