diff options
| author | Jerry DeLisle <jvdelisle@gcc.gnu.org> | 2016-10-05 04:39:33 +0000 |
|---|---|---|
| committer | Jerry DeLisle <jvdelisle@gcc.gnu.org> | 2016-10-05 04:39:33 +0000 |
| commit | ddd12b5fb06e5b7a11ef65bd50509d30305afb8b (patch) | |
| tree | f5b8d4ecd7a6e7219f4dd58d9c673e97b1111044 /gcc | |
| parent | 3aa27eae3593f5672b200cd817737704a89dee8c (diff) | |
| download | gcc-ddd12b5fb06e5b7a11ef65bd50509d30305afb8b.zip gcc-ddd12b5fb06e5b7a11ef65bd50509d30305afb8b.tar.gz gcc-ddd12b5fb06e5b7a11ef65bd50509d30305afb8b.tar.bz2 | |
2016-10-04 Jerry DeLisle <jvdelisle@gcc.gnu.org>
io/inquire.c (inquire_via_unit): Add check for internal unit
passed into child IO procedure.
From-SVN: r240768
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/testsuite/gfortran.dg/dtio_15.f90 | 33 |
1 files changed, 33 insertions, 0 deletions
diff --git a/gcc/testsuite/gfortran.dg/dtio_15.f90 b/gcc/testsuite/gfortran.dg/dtio_15.f90 new file mode 100644 index 0000000..040bb3e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dtio_15.f90 @@ -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 |