Skip to content
Merged
Show file tree
Hide file tree
Changes from 1 commit
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
Prev Previous commit
Next Next commit
Handle disconnected units and pad='no'
  • Loading branch information
awvwgk committed Dec 19, 2021
commit 1535e19689eeeef8923a1641f95d3980b4e68e8d
4 changes: 3 additions & 1 deletion doc/specs/stdlib_io.md
Original file line number Diff line number Diff line change
Expand Up @@ -236,12 +236,14 @@ Read a whole line from a formatted unit into a string variable

### Syntax

`call [[stdlib_io(module):getline(interface)]](unit, line[, iostat][, iomsg])`
`call [[stdlib_io(module):getline(interface)]] (unit, line[, iostat][, iomsg])`
`call [[stdlib_io(module):getline(interface)]] (line[, iostat][, iomsg])`

### Arguments

`unit`: Formatted input unit.
This argument is `intent(in)`.
If `unit` is not specified standard input is used.

`line`: Deferred length character or `string_type` variable.
This argument is `intent(out)`.
Expand Down
52 changes: 47 additions & 5 deletions src/stdlib_io.fypp
Original file line number Diff line number Diff line change
Expand Up @@ -6,6 +6,7 @@ module stdlib_io
!! Provides a support for file handling
!! ([Specification](../page/specs/stdlib_io.html))

use, intrinsic :: iso_fortran_env, only : input_unit
use stdlib_kinds, only: sp, dp, xdp, qp, &
int8, int16, int32, int64
use stdlib_error, only: error_stop
Expand Down Expand Up @@ -38,6 +39,8 @@ module stdlib_io
interface getline
module procedure :: getline_char
module procedure :: getline_string
module procedure :: getline_input_char
module procedure :: getline_input_string
end interface getline

interface loadtxt
Expand Down Expand Up @@ -356,17 +359,28 @@ contains
integer, parameter :: bufsize = 512
character(len=bufsize) :: buffer, msg
integer :: chunk, stat
logical :: opened

if (unit /= -1) then
inquire(unit=unit, opened=opened)
else
opened = .false.
end if

if (opened) then
open(unit=unit, pad="yes", iostat=stat, iomsg=msg)
else
stat = 1
msg = "Unit is not connected"
end if

line = ""
do
do while (stat == 0)
read(unit, '(a)', advance='no', iostat=stat, iomsg=msg, size=chunk) buffer
if (stat > 0) exit
line = line // buffer(:chunk)
if (stat < 0) then
if (is_iostat_eor(stat)) stat = 0
exit
end if
end do
if (is_iostat_eor(stat)) stat = 0

if (stat /= 0 .and. present(iomsg)) iomsg = trim(msg)
if (present(iostat)) then
Expand Down Expand Up @@ -395,4 +409,32 @@ contains
line = string_type(buffer)
end subroutine getline_string

!> Version: experimental
!>
!> Read a whole line from the standard input into a deferred length character variable
subroutine getline_input_char(line, iostat, iomsg)
!> Line to read
character(len=:), allocatable, intent(out) :: line
!> Status of operation
integer, intent(out), optional :: iostat
!> Error message
character(len=:), allocatable, optional :: iomsg

call getline(input_unit, line, iostat, iomsg)
end subroutine getline_input_char

!> Version: experimental
!>
!> Read a whole line from the standard input into a string variable
subroutine getline_input_string(line, iostat, iomsg)
!> Line to read
type(string_type), intent(out) :: line
!> Status of operation
integer, intent(out), optional :: iostat
!> Error message
character(len=:), allocatable, optional :: iomsg

call getline(input_unit, line, iostat, iomsg)
end subroutine getline_input_string

end module stdlib_io
83 changes: 82 additions & 1 deletion src/tests/io/test_getline.f90
Original file line number Diff line number Diff line change
Expand Up @@ -16,7 +16,11 @@ subroutine collect_getline(testsuite)

testsuite = [ &
new_unittest("read-char", test_read_char), &
new_unittest("read-string", test_read_string) &
new_unittest("read-string", test_read_string), &
new_unittest("pad-no", test_pad_no), &
new_unittest("iostat-end", test_iostat_end), &
new_unittest("closed-unit", test_closed_unit, should_fail=.true.), &
new_unittest("no-unit", test_no_unit, should_fail=.true.) &
]
end subroutine collect_getline

Expand All @@ -34,7 +38,9 @@ subroutine test_read_char(error)
do i = 1, 3
call getline(io, line, stat)
call check(error, stat)
if (allocated(error)) exit
call check(error, len(line), 3*10**i)
if (allocated(error)) exit
end do
close(io)
end subroutine test_read_char
Expand All @@ -53,11 +59,86 @@ subroutine test_read_string(error)
do i = 1, 3
call getline(io, line, stat)
call check(error, stat)
if (allocated(error)) exit
call check(error, len(line), 3*10**i)
if (allocated(error)) exit
end do
close(io)
end subroutine test_read_string

subroutine test_pad_no(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error

integer :: io, i, stat
character(len=:), allocatable :: line

open(newunit=io, status="scratch", pad="no")
write(io, "(a)") repeat("abc", 10), repeat("def", 100), repeat("ghi", 1000)
rewind(io)

do i = 1, 3
call getline(io, line, stat)
call check(error, stat)
if (allocated(error)) exit
call check(error, len(line), 3*10**i)
if (allocated(error)) exit
end do
close(io)
end subroutine test_pad_no

subroutine test_iostat_end(error)
use, intrinsic :: iso_fortran_env, only : iostat_end
!> Error handling
type(error_type), allocatable, intent(out) :: error

integer :: io, i, stat
character(len=:), allocatable :: line

open(newunit=io, status="scratch")
write(io, "(a)") repeat("abc", 10), repeat("def", 100), repeat("ghi", 1000)
rewind(io)

do i = 1, 3
call getline(io, line, stat)
call check(error, stat)
if (allocated(error)) exit
call check(error, len(line), 3*10**i)
if (allocated(error)) exit
end do
if (.not.allocated(error)) then
call getline(io, line, stat)
call check(error, stat, iostat_end)
end if
close(io)
end subroutine test_iostat_end

subroutine test_closed_unit(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error

integer :: io, stat
character(len=:), allocatable :: line, msg

open(newunit=io, status="scratch")
close(io)

call getline(io, line, stat, msg)
call check(error, stat, msg)
end subroutine test_closed_unit

subroutine test_no_unit(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error

integer :: io, stat
character(len=:), allocatable :: line, msg

io = -1
call getline(io, line, stat, msg)
call check(error, stat, msg)
end subroutine test_no_unit

end module test_getline


Expand Down