Mercurial > hg > CbC > CbC_gcc
diff gcc/testsuite/gfortran.dg/dtio_15.f90 @ 111:04ced10e8804
gcc 7
author | kono |
---|---|
date | Fri, 27 Oct 2017 22:46:09 +0900 |
parents | |
children | 84e7813d76e9 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/gcc/testsuite/gfortran.dg/dtio_15.f90 Fri Oct 27 22:46:09 2017 +0900 @@ -0,0 +1,33 @@ +! { 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) call abort +end program p