comparison 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
comparison
equal deleted inserted replaced
68:561a7518be6b 111:04ced10e8804
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) call abort
33 end program p