[Bug fortran/78670] New: Incorrect file position with namelist read under DTIO

[ian_harvey at bigpond dot com]

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=78670

            Bug ID: 78670
           Summary: Incorrect file position with namelist read under DTIO
           Product: gcc
           Version: 7.0
            Status: UNCONFIRMED
          Severity: normal
          Priority: P3
         Component: fortran
          Assignee: unassigned at gcc dot gnu.org
          Reporter: ian_harvey at bigpond dot com
  Target Milestone: ---

When compiled with recent trunk, the attached demonstrates that the position of
a file is incorrect when a user defined derived type input procedure is invoked
to process namelist input.  The character read from the file by the user
defined derived type input procedure appears to be the `=` character that
separates the object designator from the value in the namelist input.  The file
position when the user defined derived type input procedure is invoked should
be after that `=`.

(As a result of picking up the `=` the defined input procedure leaves the file
positioned prior to the value `a`, which then confuses the Fortran runtime and
results in an end of file condition - that's not a problem in itself.)


MODULE m
  IMPLICIT NONE

  TYPE :: t
    CHARACTER :: c
  CONTAINS
    PROCEDURE :: read_formatted
    GENERIC :: READ(FORMATTED) => read_formatted

    ! Work around for PR78659.
    PROCEDURE :: write_formatted
    GENERIC :: WRITE(FORMATTED) => write_formatted
  END TYPE t
CONTAINS
  ! Workaround for PR78659.
  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

    iostat = 0
  END SUBROUTINE write_formatted

  SUBROUTINE read_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
    CLASS(t), INTENT(INOUT) :: dtv
    INTEGER, INTENT(IN) :: unit
    CHARACTER(*), INTENT(IN) :: iotype
    INTEGER, INTENT(IN) :: v_list(:)
    INTEGER, INTENT(OUT) :: iostat
    CHARACTER(*), INTENT(INOUT) :: iomsg

    CHARACTER :: ch

    dtv%c = ''

    DO
      READ (unit, "(A)", IOSTAT=iostat, IOMSG=iomsg) ch
      IF (iostat /= 0) RETURN

      ! for debugging only.
      print "('Got ''',A,'''')", ch

      ! Store first non-blank
      IF (ch /= '') THEN
        dtv%c = ch
        RETURN
      END IF
    END DO

    READ (unit, "(A)", IOSTAT=iostat, IOMSG=iomsg) dtv%c
  END SUBROUTINE read_formatted
END MODULE m

PROGRAM p
  USE m
  IMPLICIT NONE
  TYPE(t) :: x
  NAMELIST /nml/ x
  INTEGER :: unit

  OPEN(NEWUNIT=unit, STATUS='SCRATCH', ACTION='READWRITE')

  WRITE (unit, "(A)") '&nml'
  WRITE (unit, "(A)") 'x = a'
  WRITE (unit, "(A)") '/'

  REWIND (unit)

  READ (unit, nml)
  PRINT *, x%c       ! expect `a`.
END PROGRAM p


$ gfortran -g 2016-12-04\ namelist3.f90 && ./a.out
Got '='
At line 72 of file 2016-12-04 namelist3.f90
Fortran runtime error: End of file

Error termination. Backtrace:
#0  0x7f19aad29321 in nml_get_obj_data
        at ../../.././vanilla/libgfortran/io/list_read.c:3494
#1  0x7f19aad31700 in finalize_transfer
        at ../../.././vanilla/libgfortran/io/transfer.c:3813
#2  0x40101e in p
        at /home/MEGMS2/ian/srv/home/projects/FortranMisc/2016/2016-12-04
namelist3.f90:72
#3  0x4010b5 in main
        at /home/MEGMS2/ian/srv/home/projects/FortranMisc/2016/2016-12-04
namelist3.f90:58



(The program is technically non-conforming because it executes an output
statement to an external unit while parent READ statement is active, if
necessary the print statement in read_formatted can be removed and the value of
dtv%c in the read_formatted procedure inspected after a read using a debugger.)