gcc/testsuite/gfortran.dg/deallocate_alloc_opt_3.f90

   1 ! { dg-do run }
   2 program a
   3
   4   implicit none
   5
   6   integer n
   7   character(len=70) e1
   8   character(len=30) e2
   9   integer, allocatable :: i(:)
  10
  11   e1 = 'No error'
  12   allocate(i(4))
  13   deallocate(i, stat=n, errmsg=e1)
  14   if (trim(e1) /= 'No error') STOP 1
  15
  16   e2 = 'No error'
  17   allocate(i(4))
  18   deallocate(i, stat=n, errmsg=e2)
  19   if (trim(e2) /= 'No error') STOP 2
  20
  21   e1 = 'No error'
  22   deallocate(i, stat=n, errmsg=e1)
  23   if (trim(e1) /= 'Attempt to deallocate an unallocated object') STOP 3
  24
  25   e2 = 'No error'
  26   deallocate(i, stat=n, errmsg=e2)
  27   if (trim(e2) /= 'Attempt to deallocate an unall') STOP 4
  28
  29 end program a