blob: 1e0c4caa962c390ade91dac47c594522bedb3d13 [file] [log] [blame]
! { dg-do run }
! Test that inquire of string internal unit in child process errors.
module string_m
implicit none
type person
character(10) :: aname
integer :: ijklmno
contains
procedure :: write_s
generic :: write(formatted) => write_s
end type person
contains
subroutine write_s (this, lun, iotype, vlist, istat, imsg)
class(person), intent(in) :: this
integer, intent(in) :: lun
character(len=*), intent(in) :: iotype
integer, intent(in) :: vlist(:)
integer, intent(out) :: istat
character(len=*), intent(inout) :: imsg
integer :: filesize
inquire( unit=lun, size=filesize, iostat=istat, iomsg=imsg)
if (istat /= 0) return
end subroutine write_s
end module string_m
program p
use string_m
type(person) :: s
character(len=12) :: msg
integer :: istat
character(len=256) :: imsg = ""
write( msg, "(DT)", iostat=istat) s
if (istat /= 5018) STOP 1
end program p