From c08de9db47cea407e4399c987d2b8b9b6a6413ed Mon Sep 17 00:00:00 2001 From: Jerry DeLisle Date: Sat, 11 Mar 2017 14:49:57 +0000 Subject: re PR fortran/78854 ([F03] DTIO namelist output not working on internal unit) 2017-03-11 Jerry DeLisle 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 --- gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gfortran.dg/dtio_25.f90 | 41 +++++++++++++++++++++++++++++++++++ 2 files changed, 46 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/dtio_25.f90 (limited to 'gcc') diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 8497890..5607171 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2017-03-11 Jerry DeLisle + + PR libgfortran/78854 + * gfortran.dg/dtio_25.f90: New test. + 2017-03-10 Martin Sebor * gcc.dg/tree-ssa/builtin-sprintf-warn-3.c: Add a test case. 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 + -- cgit v1.1