Modification of the function parse_mode in stdlib_experimental_io

src/stdlib_experimental_io.f90

@@ -356,26 +356,31 @@ integer function open(filename, mode) result(u)
 character(3) function parse_mode(mode) result(mode_)
 character(*), intent(in) :: mode
 
+integer::i
+character(:),allocatable::a
+
 mode_ = 'r t'
-if (len_trim(mode) == 0) return
-mode_(1:1) = mode(1:1)
 
-if (len_trim(adjustl(mode)) > 1) then
-    if (mode(2:2) == '+' )then
-        mode_(2:2) = '+'
+if (len_trim(mode) == 0) return
+a=trim(adjustl(mode))
+
+do i=1,len(a)
+    if (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)
+    else if (a(i:i) == '+') then
+        mode_(2:2) = a(i:i)
+    else if (a(i:i) == 't' .or. a(i:i) == 'b') then
+        mode_(3:3) = a(i:i)
+    else if (a(i:i) == ' ') then
+     cycle
     else
-        mode_(3:3) = mode(2:2)
+        call error_stop("Wrong character: "//a(i:i))
     endif
-end if
-
-if (len_trim(adjustl(mode)) > 2) then
-        mode_(3:3) = mode(3:3)
-end if
-
-if (mode_(1:1) == 'b') then
-    mode_(1:1) = mode_(3:3)
-    mode_(3:3) = 'b'
-end if
+end do
 
 end function
 

src/tests/io/CMakeLists.txt

@@ -13,6 +13,9 @@ target_link_libraries(test_savetxt_qp fortran_stdlib)
 add_executable(test_open test_open.f90)
 target_link_libraries(test_open fortran_stdlib)
 
+add_executable(test_parse_mode test_parse_mode.f90)
+target_link_libraries(test_parse_mode fortran_stdlib)
+
 add_test(NAME loadtxt COMMAND $<TARGET_FILE:test_loadtxt> ${CMAKE_CURRENT_BINARY_DIR}
   WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR})
 add_test(NAME savetxt COMMAND $<TARGET_FILE:test_savetxt> ${CMAKE_CURRENT_BINARY_DIR}
@@ -23,6 +26,8 @@ add_test(NAME savetxt_qp COMMAND $<TARGET_FILE:test_savetxt_qp> ${CMAKE_CURRENT_
   WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR})
 add_test(NAME open COMMAND $<TARGET_FILE:test_open> ${CMAKE_CURRENT_BINARY_DIR}
   WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR})
+add_test(NAME parse_mode COMMAND $<TARGET_FILE:test_parse_mode> ${CMAKE_CURRENT_BINARY_DIR}
+  WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR})
 
 set_tests_properties(loadtxt_qp PROPERTIES LABELS quadruple_precision)
 set_tests_properties(savetxt_qp PROPERTIES LABELS quadruple_precision)

src/tests/io/Makefile.manual

@@ -2,6 +2,7 @@ PROGS_SRC = test_loadtxt.f90 \
 			test_savetxt.f90 \
 			test_loadtxt_qp.f90 \
 			test_savetxt_qp.f90 \
+			test_parse_mode.f90 \
 			test_open.f90
 
 CLEAN_FILES = tmp.dat tmp_qp.dat io_open.dat io_open.stream

src/tests/io/test_open.f90

@@ -1,12 +1,11 @@
 program test_open
-use stdlib_experimental_io, only: open, parse_mode
+use stdlib_experimental_io, only: open
 use stdlib_experimental_error, only: assert
 implicit none
 
 character(:), allocatable :: filename
 integer :: u, a(3)
 
-call test_parse_mode()
 
 ! Text file
 filename = get_outpath() // "/io_open.dat"
@@ -75,45 +74,4 @@ function get_outpath() result(outpath)
     endif
     end function get_outpath
 
-    subroutine test_parse_mode()
-    character(3) :: m
-    m = parse_mode("")
-    call assert(m == "r t")
-
-    m = parse_mode("r")
-    call assert(m == "r t")
-    m = parse_mode("w")
-    call assert(m == "w t")
-    m = parse_mode("a")
-    call assert(m == "a t")
-
-    m = parse_mode("rb")
-    call assert(m == "r b")
-    m = parse_mode("wb")
-    call assert(m == "w b")
-    m = parse_mode("ab")
-    call assert(m == "a b")
-
-    m = parse_mode("br")
-    call assert(m == "r b")
-    m = parse_mode("bw")
-    call assert(m == "w b")
-    m = parse_mode("ba")
-    call assert(m == "a b")
-
-    m = parse_mode("r+")
-    call assert(m == "r+t")
-    m = parse_mode("w+")
-    call assert(m == "w+t")
-    m = parse_mode("a+")
-    call assert(m == "a+t")
-
-    m = parse_mode("r+b")
-    call assert(m == "r+b")
-    m = parse_mode("w+b")
-    call assert(m == "w+b")
-    m = parse_mode("a+b")
-    call assert(m == "a+b")
-    end subroutine
-
 end program

src/tests/io/test_parse_mode.f90

@@ -0,0 +1,171 @@
+program test_parse_mode
+use stdlib_experimental_io, only: parse_mode
+use stdlib_experimental_error, only: assert
+implicit none
+
+call test_parse_mode_expected_order()
+
+call test_parse_mode_reverse_order()
+
+call test_parse_mode_random_order()
+
+contains
+
+    subroutine test_parse_mode_expected_order()
+    character(3) :: m
+    m = parse_mode("")
+    call assert(m == "r t")
+
+    m = parse_mode("r")
+    call assert(m == "r t")
+    m = parse_mode("w")
+    call assert(m == "w t")
+    m = parse_mode("a")
+    call assert(m == "a t")
+    m = parse_mode("x")
+    call assert(m == "x t")
+
+    m = parse_mode("rt")
+    call assert(m == "r t")
+    m = parse_mode("wt")
+    call assert(m == "w t")
+    m = parse_mode("at")
+    call assert(m == "a t")
+    m = parse_mode("xt")
+    call assert(m == "x t")
+
+    m = parse_mode("rb")
+    call assert(m == "r b")
+    m = parse_mode("wb")
+    call assert(m == "w b")
+    m = parse_mode("ab")
+    call assert(m == "a b")
+    m = parse_mode("xb")
+    call assert(m == "x b")
+
+    m = parse_mode("r+")
+    call assert(m == "r+t")
+    m = parse_mode("w+")
+    call assert(m == "w+t")
+    m = parse_mode("a+")
+    call assert(m == "a+t")
+    m = parse_mode("x+")
+    call assert(m == "x+t")
+
+    m = parse_mode("r+t")
+    call assert(m == "r+t")
+    m = parse_mode("w+t")
+    call assert(m == "w+t")
+    m = parse_mode("a+t")
+    call assert(m == "a+t")
+    m = parse_mode("x+t")
+    call assert(m == "x+t")
+
+    m = parse_mode("r+b")
+    call assert(m == "r+b")
+    m = parse_mode("w+b")
+    call assert(m == "w+b")
+    m = parse_mode("a+b")
+    call assert(m == "a+b")
+    m = parse_mode("x+b")
+    call assert(m == "x+b")
+
+    end subroutine
+
+    subroutine test_parse_mode_reverse_order()
+    character(3) :: m
+    m = parse_mode("")
+    call assert(m == "r t")
+
+    m = parse_mode("tr")
+    call assert(m == "r t")
+    m = parse_mode("tw")
+    call assert(m == "w t")
+    m = parse_mode("ta")
+    call assert(m == "a t")
+    m = parse_mode("tx")
+    call assert(m == "x t")
+
+    m = parse_mode("br")
+    call assert(m == "r b")
+    m = parse_mode("bw")
+    call assert(m == "w b")
+    m = parse_mode("ba")
+    call assert(m == "a b")
+    m = parse_mode("bx")
+    call assert(m == "x b")
+
+    m = parse_mode("+r")
+    call assert(m == "r+t")
+    m = parse_mode("+w")
+    call assert(m == "w+t")
+    m = parse_mode("+a")
+    call assert(m == "a+t")
+    m = parse_mode("+x")
+    call assert(m == "x+t")
+
+    m = parse_mode("t+r")
+    call assert(m == "r+t")
+    m = parse_mode("t+w")
+    call assert(m == "w+t")
+    m = parse_mode("t+a")
+    call assert(m == "a+t")
+    m = parse_mode("t+x")
+    call assert(m == "x+t")
+
+    m = parse_mode("b+r")
+    call assert(m == "r+b")
+    m = parse_mode("b+w")
+    call assert(m == "w+b")
+    m = parse_mode("b+a")
+    call assert(m == "a+b")
+    m = parse_mode("x+b")
+    call assert(m == "x+b")
+
+    end subroutine
+
+    subroutine test_parse_mode_random_order()
+    character(3) :: m
+    m = parse_mode("")
+    call assert(m == "r t")
+
+    m = parse_mode("t r")
+    call assert(m == "r t")
+    m = parse_mode(" tw ")
+    call assert(m == "w t")
+    m = parse_mode("ta  ")
+    call assert(m == "a t")
+    m = parse_mode("  t   x   ")
+    call assert(m == "x t")
+
+    m = parse_mode("+ r ")
+    call assert(m == "r+t")
+    m = parse_mode("w   +")
+    call assert(m == "w+t")
+    m = parse_mode(" a+")
+    call assert(m == "a+t")
+    m = parse_mode(" x+   t  ")
+    call assert(m == "x+t")
+
+    m = parse_mode("tr+ ")
+    call assert(m == "r+t")
+    m = parse_mode("wtt + ")
+    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")
+    call assert(m == "r+t")
+    m = parse_mode(" ww + b")
+    call assert(m == "w+b")
+    m = parse_mode("a + b")
+    call assert(m == "a+b")
+    m = parse_mode(" b + x  ")
+    call assert(m == "x+b")
+
+    end subroutine
+
+
+end program