gcc/testsuite/gfortran.dg/dtio_15.f90

   1 ! { dg-do run }
   2 ! Test that inquire of string internal unit in child process errors.
   3 module string_m
   4   implicit none
   5   type person
   6     character(10) :: aname
   7     integer :: ijklmno
   8   contains
   9     procedure :: write_s
  10     generic :: write(formatted) => write_s
  11   end type person
  12 contains
  13   subroutine write_s (this, lun, iotype, vlist, istat, imsg)
  14     class(person), intent(in)       :: this
  15     integer, intent(in)             :: lun
  16     character(len=*), intent(in)    :: iotype
  17     integer, intent(in)             :: vlist(:)
  18     integer, intent(out)            :: istat
  19     character(len=*), intent(inout) :: imsg
  20     integer :: filesize
  21     inquire( unit=lun, size=filesize, iostat=istat, iomsg=imsg)
  22     if (istat /= 0) return
  23   end subroutine write_s
  24 end module string_m
  25 program p
  26    use string_m
  27    type(person) :: s
  28    character(len=12) :: msg
  29    integer :: istat
  30    character(len=256) :: imsg = ""
  31    write( msg, "(DT)", iostat=istat) s
  32    if (istat /= 5018) STOP 1
  33 end program p