gcc/testsuite/gfortran.dg/allocate_stat.f90

   1 ! { dg-do compile }
   2 ! PR fortran/32936
   3 !
   4 !
   5 function all_res()
   6   implicit none
   7   real, pointer :: gain
   8   integer :: all_res
   9   allocate (gain,STAT=all_res)
  10   deallocate(gain)
  11   call bar()
  12 contains
  13   subroutine bar()
  14     real, pointer :: gain2
  15     allocate (gain2,STAT=all_res)
  16     deallocate(gain2)
  17   end subroutine bar
  18 end function all_res
  19
  20 function func()
  21   implicit none
  22   real, pointer :: gain
  23   integer :: all_res2, func
  24   func = 0
  25 entry all_res2
  26   allocate (gain,STAT=all_res2)
  27   deallocate(gain)
  28 contains
  29   subroutine test
  30     implicit none
  31     real, pointer :: gain2
  32      allocate (gain2,STAT=all_res2)
  33      deallocate(gain2)
  34   end subroutine test
  35 end function func
  36
  37 function func2() result(res)
  38   implicit none
  39   real, pointer :: gain
  40   integer :: res
  41   allocate (gain,STAT=func2) ! { dg-error "requires an argument list" }
  42   deallocate(gain)
  43   res = 0
  44 end function func2
  45
  46 subroutine sub()
  47   implicit none
  48   interface
  49     integer function func2()
  50     end function
  51   end interface
  52   real, pointer :: gain
  53   integer, parameter :: res = 2
  54   allocate (gain,STAT=func2) ! { dg-error "requires an argument list" }
  55   deallocate(gain)
  56 end subroutine sub
  57
  58 module test
  59 contains
  60  function one()
  61    integer :: one, two
  62    integer, pointer :: ptr
  63    allocate(ptr, stat=one)
  64    if(one == 0) deallocate(ptr)
  65  entry two
  66    allocate(ptr, stat=two)
  67    if(associated(ptr)) deallocate(ptr)
  68  end function one
  69  subroutine sub()
  70    integer, pointer :: p
  71    allocate(p, stat=one) ! { dg-error "requires an argument list" }
  72    if(associated(p)) deallocate(p)
  73    allocate(p, stat=two) ! { dg-error "requires an argument list" }
  74    if(associated(p)) deallocate(p)
  75  end subroutine sub
  76 end module test