gcc/testsuite/gfortran.dg/iomsg_1.f90

   1 ! { dg-do run }
   2 ! Test implementation of the iomsg tag.
   3 program iomsg_test
   4   character(len=70) ch
   5
   6   ! Test that iomsg is left unchanged with no error
   7   ch = 'asdf'
   8   open(10, status='scratch', iomsg=ch, iostat=i)
   9   if (ch .ne. 'asdf') call abort
  10
  11   ! Test iomsg with data transfer statement
  12   read(10,'(I2)', iomsg=ch, end=100) k
  13   call abort
  14 100 continue
  15   if (ch .ne. 'End of file') call abort
  16
  17   ! Test iomsg with open
  18   open (-3, err=200, iomsg=ch)
  19
  20   call abort
  21 200 continue
  22   if (ch .ne. 'Bad unit number in OPEN statement') call abort
  23
  24   ! Test iomsg with close
  25   close(23,status="no_idea", err=500, iomsg=ch)
  26 500 continue
  27   if (ch .ne. "Bad STATUS parameter in CLOSE statement") call abort
  28 end program iomsg_test