Skip to content

Addition of checks and use of stdlib_experimental_ascii #82

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 7 commits into from
Jan 5, 2020
Merged
Show file tree
Hide file tree
Changes from all commits
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
69 changes: 38 additions & 31 deletions src/stdlib_experimental_io.f90
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,7 @@ module stdlib_experimental_io
use iso_fortran_env, only: sp=>real32, dp=>real64, qp=>real128
use stdlib_experimental_error, only: error_stop
use stdlib_experimental_optval, only: optval
use stdlib_experimental_ascii, only: is_blank
implicit none
private
! Public API
Expand Down Expand Up @@ -231,16 +232,16 @@ integer function number_of_columns(s)

integer :: ios
character :: c
logical :: lastwhite
logical :: lastblank

rewind(s)
number_of_columns = 0
lastwhite = .true.
lastblank = .true.
do
read(s, '(a)', advance='no', iostat=ios) c
if (ios /= 0) exit
if (lastwhite .and. .not. whitechar(c)) number_of_columns = number_of_columns + 1
lastwhite = whitechar(c)
if (lastblank .and. .not. is_blank(c)) number_of_columns = number_of_columns + 1
lastblank = is_blank(c)
end do
rewind(s)

Expand All @@ -265,17 +266,7 @@ integer function number_of_rows_numeric(s)

end function

pure logical function whitechar(char) ! white character
! returns .true. if char is space (32) or tab (9), .false. otherwise
character, intent(in) :: char
if (iachar(char) == 32 .or. iachar(char) == 9) then
whitechar = .true.
else
whitechar = .false.
end if
end function

integer function open(filename, mode) result(u)
integer function open(filename, mode, iostat) result(u)
! Open a file
!
! To open a file to read:
Expand All @@ -293,8 +284,10 @@ integer function open(filename, mode) result(u)

character(*), intent(in) :: filename
character(*), intent(in), optional :: mode
integer :: io
character(3):: mode_
integer, intent(out), optional :: iostat

integer :: io_
character(3) :: mode_
character(:),allocatable :: action_, position_, status_, access_, form_


Expand Down Expand Up @@ -348,37 +341,51 @@ integer function open(filename, mode) result(u)
call error_stop("Unsupported mode: "//mode_(3:3))
end select

open(newunit=u, file=filename, &
action = action_, position = position_, status = status_, &
access = access_, form = form_, &
iostat = io)
if (present(iostat)) then
open(newunit=u, file=filename, &
action = action_, position = position_, status = status_, &
access = access_, form = form_, &
iostat = iostat)
else
open(newunit=u, file=filename, &
action = action_, position = position_, status = status_, &
access = access_, form = form_)
end if

end function

character(3) function parse_mode(mode) result(mode_)
character(*), intent(in) :: mode

integer::i
character(:),allocatable::a
integer :: i
character(:),allocatable :: a
logical :: lfirst(3)

mode_ = 'r t'

if (len_trim(mode) == 0) return
a=trim(adjustl(mode))

lfirst = .true.
do i=1,len(a)
select case (a(i:i))
case('r', 'w', 'a', 'x')
if (lfirst(1) &
.and. (a(i:i) == 'r' .or. a(i:i) == 'w' .or. a(i:i) == 'a' .or. a(i:i) == 'x') &
) then
mode_(1:1) = a(i:i)
case('+')
lfirst(1)=.false.
else if (lfirst(2) .and. a(i:i) == '+') then
mode_(2:2) = a(i:i)
case('t', 'b')
lfirst(2)=.false.
else if (lfirst(3) .and. (a(i:i) == 't' .or. a(i:i) == 'b')) then
mode_(3:3) = a(i:i)
case(' ')
cycle
case default
lfirst(3)=.false.
else if (a(i:i) == ' ') then
cycle
else if(any(.not.lfirst)) then
call error_stop("Wrong mode: "//trim(a))
else
call error_stop("Wrong character: "//a(i:i))
end select
endif
end do

end function
Expand Down
26 changes: 24 additions & 2 deletions src/tests/io/test_open.f90
Original file line number Diff line number Diff line change
Expand Up @@ -4,8 +4,7 @@ program test_open
implicit none

character(:), allocatable :: filename
integer :: u, a(3)

integer :: io, u, a(3)

! Text file
filename = get_outpath() // "/io_open.dat"
Expand Down Expand Up @@ -59,6 +58,29 @@ program test_open
call assert(all(a == [4, 5, 6]))
close(u)



!0 and non-0 open
filename = get_outpath() // "/io_open.stream"

u = open(filename, "rb", io)
call assert(io == 0)
if (io == 0) close(u)

u = open(filename, "ab", io)
call assert(io == 0)
if (io == 0) close(u)


filename = get_outpath() // "/does_not_exist.error"

u = open(filename, "a", io)
call assert(io /= 0)

u = open(filename, "r", io)
call assert(io /= 0)


contains

function get_outpath() result(outpath)
Expand Down
22 changes: 19 additions & 3 deletions src/tests/io/test_parse_mode.f90
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,8 @@ program test_parse_mode

call test_parse_mode_random_order()

!call test_parse_mode_always_fail()

contains

subroutine test_parse_mode_expected_order()
Expand Down Expand Up @@ -149,16 +151,16 @@ subroutine test_parse_mode_random_order()

m = parse_mode("tr+ ")
call assert(m == "r+t")
m = parse_mode("wtt + ")
m = parse_mode("wt + ")
call assert(m == "w+t")
m = parse_mode("a + t")
call assert(m == "a+t")
m = parse_mode(" xt + ")
call assert(m == "x+t")

m = parse_mode("t + t")
m = parse_mode(" + t")
call assert(m == "r+t")
m = parse_mode(" ww + b")
m = parse_mode(" +w b")
call assert(m == "w+b")
m = parse_mode("a + b")
call assert(m == "a+b")
Expand All @@ -167,5 +169,19 @@ subroutine test_parse_mode_random_order()

end subroutine

subroutine test_parse_mode_always_fail()
character(3) :: m

m = parse_mode("r+w")
call assert(m /= "r t")

m = parse_mode("tt")
call assert(m /= "r t")

m = parse_mode("bt")
call assert(m /= "r t")

end subroutine


end program