Mercurial > hg > CbC > CbC_gcc
view gcc/testsuite/gfortran.dg/dtio_15.f90 @ 158:494b0b89df80 default tip
...
author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
---|---|
date | Mon, 25 May 2020 18:13:55 +0900 |
parents | 84e7813d76e9 |
children |
line wrap: on
line source
! { 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