Skip to content

Commit 08d0d07

Browse files
awvwgkawvwgk
committed
Deploying to stdlib-fpm from @ bae6be5 🚀
1 parent 5a659c8 commit 08d0d07

File tree

2 files changed

+276
-1
lines changed

2 files changed

+276
-1
lines changed

‎src/stdlib_io.f90

Lines changed: 107 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -4,15 +4,17 @@ module stdlib_io
44
!! Provides a support for file handling
55
!! ([Specification](../page/specs/stdlib_io.html))
66

7+
use, intrinsic :: iso_fortran_env, only : input_unit
78
use stdlib_kinds, only: sp, dp, xdp, qp, &
89
int8, int16, int32, int64
910
use stdlib_error, only: error_stop
1011
use stdlib_optval, only: optval
1112
use stdlib_ascii, only: is_blank
13+
use stdlib_string_type, only : string_type
1214
implicit none
1315
private
1416
! Public API
15-
public :: loadtxt, savetxt, open
17+
public :: loadtxt, savetxt, open, getline
1618

1719
! Private API that is exposed so that we can test it in tests
1820
public :: parse_mode
@@ -29,6 +31,16 @@ module stdlib_io
2931
FMT_COMPLEX_XDP = '(*(es26.18e3,1x,es26.18e3))', &
3032
FMT_COMPLEX_QP = '(*(es44.35e4,1x,es44.35e4))'
3133

34+
!> Version: experimental
35+
!>
36+
!> Read a whole line from a formatted unit into a string variable
37+
interface getline
38+
module procedure :: getline_char
39+
module procedure :: getline_string
40+
module procedure :: getline_input_char
41+
module procedure :: getline_input_string
42+
end interface getline
43+
3244
interface loadtxt
3345
!! version: experimental
3446
!!
@@ -838,4 +850,98 @@ character(3) function parse_mode(mode) result(mode_)
838850

839851
end function parse_mode
840852

853+
!> Version: experimental
854+
!>
855+
!> Read a whole line from a formatted unit into a deferred length character variable
856+
subroutine getline_char(unit, line, iostat, iomsg)
857+
!> Formatted IO unit
858+
integer, intent(in) :: unit
859+
!> Line to read
860+
character(len=:), allocatable, intent(out) :: line
861+
!> Status of operation
862+
integer, intent(out), optional :: iostat
863+
!> Error message
864+
character(len=:), allocatable, optional :: iomsg
865+
866+
integer, parameter :: bufsize = 4096
867+
character(len=bufsize) :: buffer, msg
868+
integer :: chunk, stat
869+
logical :: opened
870+
871+
if (unit /= -1) then
872+
inquire(unit=unit, opened=opened)
873+
else
874+
opened = .false.
875+
end if
876+
877+
if (opened) then
878+
open(unit=unit, pad="yes", iostat=stat, iomsg=msg)
879+
else
880+
stat = 1
881+
msg = "Unit is not connected"
882+
end if
883+
884+
line = ""
885+
do while (stat == 0)
886+
read(unit, '(a)', advance='no', iostat=stat, iomsg=msg, size=chunk) buffer
887+
if (stat > 0) exit
888+
line = line // buffer(:chunk)
889+
end do
890+
if (is_iostat_eor(stat)) stat = 0
891+
892+
if (stat /= 0 .and. present(iomsg)) iomsg = trim(msg)
893+
if (present(iostat)) then
894+
iostat = stat
895+
else if (stat /= 0) then
896+
call error_stop(trim(msg))
897+
end if
898+
end subroutine getline_char
899+
900+
!> Version: experimental
901+
!>
902+
!> Read a whole line from a formatted unit into a string variable
903+
subroutine getline_string(unit, line, iostat, iomsg)
904+
!> Formatted IO unit
905+
integer, intent(in) :: unit
906+
!> Line to read
907+
type(string_type), intent(out) :: line
908+
!> Status of operation
909+
integer, intent(out), optional :: iostat
910+
!> Error message
911+
character(len=:), allocatable, optional :: iomsg
912+
913+
character(len=:), allocatable :: buffer
914+
915+
call getline(unit, buffer, iostat, iomsg)
916+
line = string_type(buffer)
917+
end subroutine getline_string
918+
919+
!> Version: experimental
920+
!>
921+
!> Read a whole line from the standard input into a deferred length character variable
922+
subroutine getline_input_char(line, iostat, iomsg)
923+
!> Line to read
924+
character(len=:), allocatable, intent(out) :: line
925+
!> Status of operation
926+
integer, intent(out), optional :: iostat
927+
!> Error message
928+
character(len=:), allocatable, optional :: iomsg
929+
930+
call getline(input_unit, line, iostat, iomsg)
931+
end subroutine getline_input_char
932+
933+
!> Version: experimental
934+
!>
935+
!> Read a whole line from the standard input into a string variable
936+
subroutine getline_input_string(line, iostat, iomsg)
937+
!> Line to read
938+
type(string_type), intent(out) :: line
939+
!> Status of operation
940+
integer, intent(out), optional :: iostat
941+
!> Error message
942+
character(len=:), allocatable, optional :: iomsg
943+
944+
call getline(input_unit, line, iostat, iomsg)
945+
end subroutine getline_input_string
946+
841947
end module stdlib_io

‎test/test_getline.f90

Lines changed: 169 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,169 @@
1+
module test_getline
2+
use stdlib_io, only : getline
3+
use stdlib_string_type, only : string_type, len
4+
use testdrive, only : new_unittest, unittest_type, error_type, check
5+
implicit none
6+
private
7+
8+
public :: collect_getline
9+
10+
contains
11+
12+
!> Collect all exported unit tests
13+
subroutine collect_getline(testsuite)
14+
!> Collection of tests
15+
type(unittest_type), allocatable, intent(out) :: testsuite(:)
16+
17+
testsuite = [ &
18+
new_unittest("read-char", test_read_char), &
19+
new_unittest("read-string", test_read_string), &
20+
new_unittest("pad-no", test_pad_no), &
21+
new_unittest("iostat-end", test_iostat_end), &
22+
new_unittest("closed-unit", test_closed_unit, should_fail=.true.), &
23+
new_unittest("no-unit", test_no_unit, should_fail=.true.) &
24+
]
25+
end subroutine collect_getline
26+
27+
subroutine test_read_char(error)
28+
!> Error handling
29+
type(error_type), allocatable, intent(out) :: error
30+
31+
integer :: io, i, stat
32+
character(len=:), allocatable :: line
33+
34+
open(newunit=io, status="scratch")
35+
write(io, "(a)") repeat("abc", 10), repeat("def", 100), repeat("ghi", 1000)
36+
rewind(io)
37+
38+
do i = 1, 3
39+
call getline(io, line, stat)
40+
call check(error, stat)
41+
if (allocated(error)) exit
42+
call check(error, len(line), 3*10**i)
43+
if (allocated(error)) exit
44+
end do
45+
close(io)
46+
end subroutine test_read_char
47+
48+
subroutine test_read_string(error)
49+
!> Error handling
50+
type(error_type), allocatable, intent(out) :: error
51+
52+
integer :: io, i, stat
53+
type(string_type) :: line
54+
55+
open(newunit=io, status="scratch")
56+
write(io, "(a)") repeat("abc", 10), repeat("def", 100), repeat("ghi", 1000)
57+
rewind(io)
58+
59+
do i = 1, 3
60+
call getline(io, line, stat)
61+
call check(error, stat)
62+
if (allocated(error)) exit
63+
call check(error, len(line), 3*10**i)
64+
if (allocated(error)) exit
65+
end do
66+
close(io)
67+
end subroutine test_read_string
68+
69+
subroutine test_pad_no(error)
70+
!> Error handling
71+
type(error_type), allocatable, intent(out) :: error
72+
73+
integer :: io, i, stat
74+
character(len=:), allocatable :: line
75+
76+
open(newunit=io, status="scratch", pad="no")
77+
write(io, "(a)") repeat("abc", 10), repeat("def", 100), repeat("ghi", 1000)
78+
rewind(io)
79+
80+
do i = 1, 3
81+
call getline(io, line, stat)
82+
call check(error, stat)
83+
if (allocated(error)) exit
84+
call check(error, len(line), 3*10**i)
85+
if (allocated(error)) exit
86+
end do
87+
close(io)
88+
end subroutine test_pad_no
89+
90+
subroutine test_iostat_end(error)
91+
use, intrinsic :: iso_fortran_env, only : iostat_end
92+
!> Error handling
93+
type(error_type), allocatable, intent(out) :: error
94+
95+
integer :: io, i, stat
96+
character(len=:), allocatable :: line
97+
98+
open(newunit=io, status="scratch")
99+
write(io, "(a)") repeat("abc", 10), repeat("def", 100), repeat("ghi", 1000)
100+
rewind(io)
101+
102+
do i = 1, 3
103+
call getline(io, line, stat)
104+
call check(error, stat)
105+
if (allocated(error)) exit
106+
call check(error, len(line), 3*10**i)
107+
if (allocated(error)) exit
108+
end do
109+
if (.not.allocated(error)) then
110+
call getline(io, line, stat)
111+
call check(error, stat, iostat_end)
112+
end if
113+
close(io)
114+
end subroutine test_iostat_end
115+
116+
subroutine test_closed_unit(error)
117+
!> Error handling
118+
type(error_type), allocatable, intent(out) :: error
119+
120+
integer :: io, stat
121+
character(len=:), allocatable :: line, msg
122+
123+
open(newunit=io, status="scratch")
124+
close(io)
125+
126+
call getline(io, line, stat, msg)
127+
call check(error, stat, msg)
128+
end subroutine test_closed_unit
129+
130+
subroutine test_no_unit(error)
131+
!> Error handling
132+
type(error_type), allocatable, intent(out) :: error
133+
134+
integer :: io, stat
135+
character(len=:), allocatable :: line, msg
136+
137+
io = -1
138+
call getline(io, line, stat, msg)
139+
call check(error, stat, msg)
140+
end subroutine test_no_unit
141+
142+
end module test_getline
143+
144+
145+
program tester
146+
use, intrinsic :: iso_fortran_env, only : error_unit
147+
use testdrive, only : run_testsuite, new_testsuite, testsuite_type
148+
use test_getline, only : collect_getline
149+
implicit none
150+
integer :: stat, is
151+
type(testsuite_type), allocatable :: testsuites(:)
152+
character(len=*), parameter :: fmt = '("#", *(1x, a))'
153+
154+
stat = 0
155+
156+
testsuites = [ &
157+
new_testsuite("getline", collect_getline) &
158+
]
159+
160+
do is = 1, size(testsuites)
161+
write(error_unit, fmt) "Testing:", testsuites(is)%name
162+
call run_testsuite(testsuites(is)%collect, error_unit, stat)
163+
end do
164+
165+
if (stat > 0) then
166+
write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!"
167+
error stop
168+
end if
169+
end program

0 commit comments

Comments
 (0)