gcc/testsuite/gfortran.dg/deallocate_stat_2.f90

   1 ! { dg-do run }
   2 !
   3 ! Check that the error is properly diagnosed and the strings are correctly padded.
   4 !
   5 integer, allocatable :: A, B(:)
   6 integer :: stat
   7 character(len=5) :: sstr
   8 character(len=200) :: str
   9
  10 str = repeat('X', len(str))
  11 deallocate(a, stat=stat, errmsg=str)
  12 !print *, stat, trim(str)
  13 if (stat == 0 .or. str /= "Attempt to deallocate an unallocated object") call abort()
  14
  15 str = repeat('Y', len(str))
  16 deallocate(b, stat=stat, errmsg=str)
  17 !print *, stat, trim(str)
  18 if (stat == 0 .or. str /= "Attempt to deallocate an unallocated object") call abort()
  19
  20 sstr = repeat('Q', len(sstr))
  21 deallocate(a, stat=stat, errmsg=sstr)
  22 !print *, stat, trim(sstr)
  23 if (stat == 0 .or. sstr /= "Attem") call abort()
  24
  25 sstr = repeat('P', len(sstr))
  26 deallocate(b, stat=stat, errmsg=sstr)
  27 !print *, stat, trim(sstr)
  28 if (stat == 0 .or. sstr /= "Attem") call abort()
  29
  30 end