Skip to content

gfortran bug for string_type UDDTIO? #354

Open
@LKedward

Description

@LKedward
Member

I have the following simple program that writes three lines to a file and then reads the same three lines using string_type UDDTIO:

module test_mod
use stdlib_string_type
implicit none

contains

subroutine write_file()
  integer :: fh

  open(newunit=fh,file="scratch.txt",status="unknown")

  write(fh,*) 'This is line one'
  write(fh,*) 'This is line two'
  write(fh,*) 'This is line three'

  close(fh)

end subroutine write_file

subroutine read_file()
  
  integer :: fh, ios
  type(string_type) :: line

  open(newunit=fh,file="scratch.txt",status="unknown")

  do
    read(fh,*,iostat=ios) line
    if (ios /= 0) exit
    write(*,*) line
  end do

  close(fh)

end subroutine read_file

end module test_mod

program test
  use test_mod
  implicit none

  call write_file()

  call read_file()

end program test

With gfortran (10.1.0) only the first line is printed back, whereas Intel fortran (2021.1.2) prints all three lines.
Is this a bug in stdlib_string_type, a bug in gfortran UDDTIO, or have I done something wrong with my use of string_type?

(I'm using the stdlib-fpm package which is at stdlib commit b522bbb).

Activity

ghost

ghost commented on Mar 20, 2021

@ghost

I can confirm that this bug also happens with gfortran 8, 9 and 10 on Windows x64.

awvwgk

awvwgk commented on Mar 20, 2021

@awvwgk
Member

Well, this is disappointing. When implementing the formatted read I had to drop the iotype == "DT" case because I couldn't get consistent behaviour between Intel and GCC by any means, the list directed formatted read seemed more consistent, but apparently this is not the case. I guess this is the inverse case now, you can check the iostat, I'm would almost bet it is iostat_eor.

I would take option three from the table, because that was exactly the intended use. I will check with the NAG compiler if I find some time to get a third opinion here.

There is a fair chance I messed up something in the implementation. To read a whole line in the string I'm using a non-advancing read over chunks which will always trigger end of record, which is an implementation detail and should be caught and removed in the UDDTIO implementation. This is done by setting iostat to zero here

if (is_iostat_eor(iostat)) then
iostat = 0
end if

Apparently this is still insufficient?

awvwgk

awvwgk commented on Mar 21, 2021

@awvwgk
Member

NAG fails in the UDDTIO at

read(unit, '(a)', iostat=iostat, iomsg=iomsg, size=chunk, advance='no') &
buffer

and returns an iostat/iomsg which don't look right:

 iomsg: SIZE= is not valid without ADVANCE='NO'
 iostat: 221

So no tiebreaker here.

awvwgk

awvwgk commented on Mar 21, 2021

@awvwgk
Member

Also the error status returned by GFortran after the second read is iostat_end, but inspecting the scratch file reveals there are indeed more lines present.

awvwgk

awvwgk commented on Apr 4, 2021

@awvwgk
Member

I think I found a hint on this issue, you set the buffersize to 1 and inspect the buffer and the chunk values:

integer, parameter :: buffer_size = 512

You will find that chunk will be incremented on every read by one, which is incorrect. Using read_line on its own works fine with GCC, so this is an issue of the unit available in the UDDTIO. Next step would be a bug report for GCC, a minimal reproducer is here:
mwe.tar.gz

File scratch.txt contains those lines:

 (1) Some value
 (2) Important saved value
 (3) Another line

But the output shows after two reads:

string: "(3) Another line              "
stat: 0
is_iostat_eor(stat): F
is_iostat_end(stat): F

Which is both the wrong line and the wrong length of the raw value.

awvwgk

awvwgk commented on Jun 2, 2021

@awvwgk
Member
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment

Metadata

Metadata

Assignees

No one assigned

    Labels

    bugSomething isn't workingcompiler: gfortranSpecific to GCC Fortran compilertopic: stringsString processing

    Type

    No type

    Projects

    No projects

    Milestone

    No milestone

    Relationships

    None yet

      Development

      No branches or pull requests

        Participants

        @LKedward@awvwgk

        Issue actions

          gfortran bug for string_type UDDTIO? · Issue #354 · fortran-lang/stdlib