diff options
| author | Jerry DeLisle <jvdelisle@gcc.gnu.org> | 2017-03-11 14:49:57 +0000 |
|---|---|---|
| committer | Jerry DeLisle <jvdelisle@gcc.gnu.org> | 2017-03-11 14:49:57 +0000 |
| commit | c08de9db47cea407e4399c987d2b8b9b6a6413ed (patch) | |
| tree | 0c0816499c2d1669fe279e6c7c3afde3190d275d /gcc/testsuite/gfortran.dg | |
| parent | 85059a38cba2e84d0242f5d0b835ab95ad4b4965 (diff) | |
| download | gcc-c08de9db47cea407e4399c987d2b8b9b6a6413ed.zip gcc-c08de9db47cea407e4399c987d2b8b9b6a6413ed.tar.gz gcc-c08de9db47cea407e4399c987d2b8b9b6a6413ed.tar.bz2 | |
re PR fortran/78854 ([F03] DTIO namelist output not working on internal unit)
2017-03-11 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libgfortran/78854
* io/list_read.c (nml_get_obj_data): Stash internal unit for
later use by child procedures.
* io/write.c (nml_write_obj): Likewise.
* io/tranfer.c (data_transfer_init): Minor whitespace.
* io/unit.c (set_internal_uit): Look for the stashed internal
unit and use it if found.
* gfortran.dg/dtio_25.f90: New test.
From-SVN: r246070
Diffstat (limited to 'gcc/testsuite/gfortran.dg')
| -rw-r--r-- | gcc/testsuite/gfortran.dg/dtio_25.f90 | 41 |
1 files changed, 41 insertions, 0 deletions
diff --git a/gcc/testsuite/gfortran.dg/dtio_25.f90 b/gcc/testsuite/gfortran.dg/dtio_25.f90 new file mode 100644 index 0000000..fc049cd --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dtio_25.f90 @@ -0,0 +1,41 @@ +! { dg-do run } +! PR78854 namelist write to internal unit. +module m + implicit none + type :: t + character :: c + integer :: k + contains + procedure :: write_formatted + generic :: write(formatted) => write_formatted + end type +contains + subroutine write_formatted(dtv, unit, iotype, v_list, iostat, iomsg) + class(t), intent(in) :: dtv + integer, intent(in) :: unit + character(*), intent(in) :: iotype + integer, intent(in) :: v_list(:) + integer, intent(out) :: iostat + character(*), intent(inout) :: iomsg + if (iotype.eq."NAMELIST") then + write (unit, '(a,a,a,a,i5)') 'x%c="',dtv%c,'",','x%k=', dtv%k + else + write (unit,*) dtv%c, dtv%k + end if + end subroutine +end module + +program p + use m + implicit none + character(len=50) :: buffer + type(t) :: x + namelist /nml/ x + x = t('a', 5) + write (buffer, nml) + if (buffer.ne.'&NML x%c="a",x%k= 5 /') call abort + x = t('x', 0) + read (buffer, nml) + if (x%c.ne.'a'.or. x%k.ne.5) call abort +end + |