gcc/testsuite/gfortran.dg/allocatable_function_1.f90

   1 ! { dg-do run }
   2 ! { dg-options "-O2 -fdump-tree-original" }
   3 ! Test ALLOCATABLE functions; the primary purpose here is to check that
   4 ! each of the various types of reference result in the function result
   5 ! being deallocated, using _gfortran_internal_free.
   6 ! The companion, allocatable_function_1r.f90, executes this program.
   7 !
   8 subroutine moobar (a)
   9     integer, intent(in) :: a(:)
  10
  11     if (.not.all(a == [ 1, 2, 3 ])) call abort()
  12 end subroutine moobar
  13
  14 function foo2 (n)
  15     integer, intent(in) :: n
  16     integer, allocatable :: foo2(:)
  17     integer :: i
  18     allocate (foo2(n))
  19     do i = 1, n
  20         foo2(i) = i
  21     end do
  22 end function foo2
  23
  24 module m
  25 contains
  26     function foo3 (n)
  27         integer, intent(in) :: n
  28         integer, allocatable :: foo3(:)
  29         integer :: i
  30         allocate (foo3(n))
  31         do i = 1, n
  32             foo3(i) = i
  33         end do
  34     end function foo3
  35 end module m
  36
  37 program alloc_fun
  38
  39     use m
  40     implicit none
  41
  42     integer :: a(3)
  43
  44     interface
  45       subroutine moobar (a)
  46           integer, intent(in) :: a(:)
  47       end subroutine moobar
  48     end interface
  49
  50     interface
  51         function foo2 (n)
  52             integer, intent(in) :: n
  53             integer, allocatable :: foo2(:)
  54         end function foo2
  55     end interface
  56
  57 ! 2 _gfortran_internal_free's
  58     if (.not.all(foo1(3) == [ 1, 2, 3 ])) call abort()
  59     a = foo1(size(a))
  60
  61 ! 1 _gfortran_internal_free
  62     if (.not.all(a == [ 1, 2, 3 ])) call abort()
  63     call foobar(foo1(3))
  64
  65 ! 1 _gfortran_internal_free
  66     if (.not.all(2*bar(size(a)) + 5 == [ 7, 9, 11 ])) call abort()
  67
  68 ! Although the rhs determines the loop size, the lhs reference is
  69 ! evaluated, in case it has side-effects or is needed for bounds checking.
  70 ! 3 _gfortran_internal_free's
  71     a(1:size (bar (3))) = 2*bar(size(a)) + 2 + a(size (bar (3)))
  72     if (.not.all(a == [ 7, 9, 11 ])) call abort()
  73
  74 ! 3 _gfortran_internal_free's
  75     call moobar(foo1(3))   ! internal function
  76     call moobar(foo2(3))   ! module function
  77     call moobar(foo3(3))   ! explicit interface
  78
  79 ! 9 _gfortran_internal_free's in total
  80 contains
  81
  82     subroutine foobar (a)
  83         integer, intent(in) :: a(:)
  84
  85         if (.not.all(a == [ 1, 2, 3 ])) call abort()
  86     end subroutine foobar
  87
  88     function foo1 (n)
  89         integer, intent(in) :: n
  90         integer, allocatable :: foo1(:)
  91         integer :: i
  92         allocate (foo1(n))
  93         do i = 1, n
  94             foo1(i) = i
  95         end do
  96     end function foo1
  97
  98     function bar (n) result(b)
  99         integer, intent(in) :: n
 100         integer, target, allocatable :: b(:)
 101         integer :: i
 102
 103         allocate (b(n))
 104         do i = 1, n
 105             b(i) = i
 106         end do
 107     end function bar
 108
 109 end program alloc_fun
 110 ! { dg-final { scan-tree-dump-times "free" 10 "original" } }
 111 ! { dg-final { cleanup-tree-dump "original" } }
 112 ! { dg-final { cleanup-modules "m" } }