Mercurial > hg > CbC > CbC_gcc
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 |