gcc/testsuite/gfortran.dg/allocate_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), stat=n, errmsg=e1)
  13   if (trim(e1) /= 'No error') STOP 1
  14   deallocate(i)
  15
  16   e2 = 'No error'
  17   allocate(i(4),stat=n, errmsg=e2)
  18   if (trim(e2) /= 'No error') STOP 2
  19   deallocate(i)
  20
  21
  22   e1 = 'No error'
  23   allocate(i(4), stat=n, errmsg=e1)
  24   allocate(i(4), stat=n, errmsg=e1)
  25   if (trim(e1) /= 'Attempt to allocate an allocated object') STOP 3
  26   deallocate(i)
  27
  28   e2 = 'No error'
  29   allocate(i(4), stat=n, errmsg=e2)
  30   allocate(i(4), stat=n, errmsg=e2)
  31   if (trim(e2) /= 'Attempt to allocate an allocat') STOP 4
  32
  33 end program a