From 91f780eb49968c511cbc6f64f4db66b45ec46e5f Mon Sep 17 00:00:00 2001 From: "Vandenplas, Jeremie" Date: Sun, 5 Jan 2020 10:04:16 +0100 Subject: [PATCH 1/7] parse_mode: addition of conditionals for checking wrong modes --- src/stdlib_experimental_io.f90 | 28 ++++++++++++++++++---------- src/tests/io/test_parse_mode.f90 | 22 +++++++++++++++++++--- 2 files changed, 37 insertions(+), 13 deletions(-) diff --git a/src/stdlib_experimental_io.f90 b/src/stdlib_experimental_io.f90 index 547f9c0a9..a1b440dc8 100644 --- a/src/stdlib_experimental_io.f90 +++ b/src/stdlib_experimental_io.f90 @@ -358,27 +358,35 @@ integer function open(filename, mode) result(u) 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 diff --git a/src/tests/io/test_parse_mode.f90 b/src/tests/io/test_parse_mode.f90 index dca731952..9d7d68b63 100644 --- a/src/tests/io/test_parse_mode.f90 +++ b/src/tests/io/test_parse_mode.f90 @@ -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() @@ -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") @@ -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 From c6bc681b010fdc11710396589166efec7fd1ed95 Mon Sep 17 00:00:00 2001 From: "Vandenplas, Jeremie" Date: Sun, 5 Jan 2020 10:19:43 +0100 Subject: [PATCH 2/7] stblib_experimental_io: addition of an io variable in the open function --- src/stdlib_experimental_io.f90 | 10 +++++++--- src/tests/io/test_open.f90 | 23 ++++++++++++++++++----- 2 files changed, 25 insertions(+), 8 deletions(-) diff --git a/src/stdlib_experimental_io.f90 b/src/stdlib_experimental_io.f90 index a1b440dc8..7144e9cad 100644 --- a/src/stdlib_experimental_io.f90 +++ b/src/stdlib_experimental_io.f90 @@ -275,7 +275,7 @@ pure logical function whitechar(char) ! white character end if end function -integer function open(filename, mode) result(u) +integer function open(filename, mode, io) result(u) ! Open a file ! ! To open a file to read: @@ -293,7 +293,9 @@ integer function open(filename, mode) result(u) character(*), intent(in) :: filename character(*), intent(in), optional :: mode -integer :: io +integer, intent(out), optional :: io + +integer :: io_ character(3):: mode_ character(:),allocatable :: action_, position_, status_, access_, form_ @@ -351,7 +353,9 @@ integer function open(filename, mode) result(u) open(newunit=u, file=filename, & action = action_, position = position_, status = status_, & access = access_, form = form_, & - iostat = io) + iostat = io_) + +if(present(io))io=io_ end function diff --git a/src/tests/io/test_open.f90 b/src/tests/io/test_open.f90 index 7e105b457..7feb8e289 100644 --- a/src/tests/io/test_open.f90 +++ b/src/tests/io/test_open.f90 @@ -4,7 +4,16 @@ program test_open implicit none character(:), allocatable :: filename -integer :: u, a(3) +integer :: io, u, a(3) + +!Wrong open +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) ! Text file @@ -38,21 +47,25 @@ program test_open filename = get_outpath() // "/io_open.stream" ! Test mode "w" -u = open(filename, "wb") +u = open(filename, "wb", io) +call assert(io == 0) write(u) 1, 2, 3 close(u) ! Test mode "r" -u = open(filename, "rb") +u = open(filename, "rb", io) +call assert(io == 0) read(u) a call assert(all(a == [1, 2, 3])) close(u) ! Test mode "a" -u = open(filename, "ab") +u = open(filename, "ab", io) +call assert(io == 0) write(u) 4, 5, 6 close(u) -u = open(filename, "rb") +u = open(filename, "rb", io) +call assert(io == 0) read(u) a call assert(all(a == [1, 2, 3])) read(u) a From dd027ada78f62a87f898eb50671b7c47de38fb67 Mon Sep 17 00:00:00 2001 From: "Vandenplas, Jeremie" Date: Sun, 5 Jan 2020 10:24:56 +0100 Subject: [PATCH 3/7] stdlib_experimental_io: changed whitechar for is_blank provided by stdlib_experimental_ascii --- src/stdlib_experimental_io.f90 | 15 +++------------ 1 file changed, 3 insertions(+), 12 deletions(-) diff --git a/src/stdlib_experimental_io.f90 b/src/stdlib_experimental_io.f90 index 7144e9cad..b883b4f23 100644 --- a/src/stdlib_experimental_io.f90 +++ b/src/stdlib_experimental_io.f90 @@ -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 @@ -239,8 +240,8 @@ integer function number_of_columns(s) 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 (lastwhite .and. .not. is_blank(c)) number_of_columns = number_of_columns + 1 + lastwhite = is_blank(c) end do rewind(s) @@ -265,16 +266,6 @@ 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, io) result(u) ! Open a file ! From 08374dbc6806f9a40598a4a5f6afdac7bfd5525c Mon Sep 17 00:00:00 2001 From: "Vandenplas, Jeremie" Date: Sun, 5 Jan 2020 10:27:41 +0100 Subject: [PATCH 4/7] correction of a typo --- src/stdlib_experimental_io.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_experimental_io.f90 b/src/stdlib_experimental_io.f90 index b883b4f23..50dfb1172 100644 --- a/src/stdlib_experimental_io.f90 +++ b/src/stdlib_experimental_io.f90 @@ -287,7 +287,7 @@ integer function open(filename, mode, io) result(u) integer, intent(out), optional :: io integer :: io_ -character(3):: mode_ +character(3) :: mode_ character(:),allocatable :: action_, position_, status_, access_, form_ From 537e411978e1ca87577ba196d6247d8bf17d7e84 Mon Sep 17 00:00:00 2001 From: "Vandenplas, Jeremie" Date: Sun, 5 Jan 2020 15:45:11 +0100 Subject: [PATCH 5/7] changed lastwhite to lastblank (proposed by @ivan-pi) --- src/stdlib_experimental_io.f90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/stdlib_experimental_io.f90 b/src/stdlib_experimental_io.f90 index 50dfb1172..3220eba1a 100644 --- a/src/stdlib_experimental_io.f90 +++ b/src/stdlib_experimental_io.f90 @@ -232,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. is_blank(c)) number_of_columns = number_of_columns + 1 - lastwhite = is_blank(c) + if (lastblank .and. .not. is_blank(c)) number_of_columns = number_of_columns + 1 + lastblank = is_blank(c) end do rewind(s) From 7d8174430a7f8b1c6b2e38f250a80354f995d9e7 Mon Sep 17 00:00:00 2001 From: "Vandenplas, Jeremie" Date: Sun, 5 Jan 2020 17:42:09 +0100 Subject: [PATCH 6/7] changes suggested by @certik --- src/stdlib_experimental_io.f90 | 20 +++++++++------ src/tests/io/test_open.f90 | 45 ++++++++++++++++++++-------------- 2 files changed, 39 insertions(+), 26 deletions(-) diff --git a/src/stdlib_experimental_io.f90 b/src/stdlib_experimental_io.f90 index 3220eba1a..afc55e647 100644 --- a/src/stdlib_experimental_io.f90 +++ b/src/stdlib_experimental_io.f90 @@ -266,7 +266,7 @@ integer function number_of_rows_numeric(s) end function -integer function open(filename, mode, io) result(u) +integer function open(filename, mode, iostat) result(u) ! Open a file ! ! To open a file to read: @@ -284,7 +284,7 @@ integer function open(filename, mode, io) result(u) character(*), intent(in) :: filename character(*), intent(in), optional :: mode -integer, intent(out), optional :: io +integer, intent(out), optional :: iostat integer :: io_ character(3) :: mode_ @@ -341,12 +341,16 @@ integer function open(filename, mode, io) 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(io))io=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 diff --git a/src/tests/io/test_open.f90 b/src/tests/io/test_open.f90 index 7feb8e289..5d0026f9a 100644 --- a/src/tests/io/test_open.f90 +++ b/src/tests/io/test_open.f90 @@ -6,16 +6,6 @@ program test_open character(:), allocatable :: filename integer :: io, u, a(3) -!Wrong open -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) - - ! Text file filename = get_outpath() // "/io_open.dat" @@ -47,31 +37,50 @@ program test_open filename = get_outpath() // "/io_open.stream" ! Test mode "w" -u = open(filename, "wb", io) -call assert(io == 0) +u = open(filename, "wb") write(u) 1, 2, 3 close(u) ! Test mode "r" -u = open(filename, "rb", io) -call assert(io == 0) +u = open(filename, "rb") read(u) a call assert(all(a == [1, 2, 3])) close(u) ! Test mode "a" -u = open(filename, "ab", io) -call assert(io == 0) +u = open(filename, "ab") write(u) 4, 5, 6 close(u) -u = open(filename, "rb", io) -call assert(io == 0) +u = open(filename, "rb") read(u) a call assert(all(a == [1, 2, 3])) read(u) a 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") +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) From 6410e0d134689d4b9cf975b4ec17240e136eab85 Mon Sep 17 00:00:00 2001 From: "Vandenplas, Jeremie" Date: Sun, 5 Jan 2020 18:33:57 +0100 Subject: [PATCH 7/7] added 1 io in test_open --- src/tests/io/test_open.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/tests/io/test_open.f90 b/src/tests/io/test_open.f90 index 5d0026f9a..deaee3593 100644 --- a/src/tests/io/test_open.f90 +++ b/src/tests/io/test_open.f90 @@ -67,7 +67,7 @@ program test_open call assert(io == 0) if (io == 0) close(u) -u = open(filename, "ab") +u = open(filename, "ab", io) call assert(io == 0) if (io == 0) close(u)