|
111
|
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
|
