Implement open(filename, mode) and use it

src/Makefile.manual

@@ -28,3 +28,4 @@ clean:
 
 # Fortran module dependencies
 f18estop.o: stdlib_experimental_error.o
+stdlib_experimental_io.o: stdlib_experimental_error.o stdlib_experimental_optval.o

src/stdlib_experimental_io.f90

@@ -1,8 +1,15 @@
 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
 implicit none
 private
-public :: loadtxt, savetxt
+! Public API
+public :: loadtxt, savetxt, open
+
+! Private API that is exposed so that we can test it in tests
+public :: parse_mode
+
 
 interface loadtxt
     module procedure sloadtxt
@@ -46,7 +53,7 @@ subroutine sloadtxt(filename, d)
 integer :: s
 integer :: nrow,ncol,i
 
-open(newunit=s, file=filename, status="old", action="read")
+s = open(filename)
 
 ! determine number of columns
 ncol = number_of_columns(s)
@@ -89,7 +96,7 @@ subroutine dloadtxt(filename, d)
 integer :: s
 integer :: nrow,ncol,i
 
-open(newunit=s, file=filename, status="old", action="read")
+s = open(filename)
 
 ! determine number of columns
 ncol = number_of_columns(s)
@@ -132,7 +139,7 @@ subroutine qloadtxt(filename, d)
 integer :: s
 integer :: nrow,ncol,i
 
-open(newunit=s, file=filename, status="old", action="read")
+s = open(filename)
 
 ! determine number of columns
 ncol = number_of_columns(s)
@@ -164,7 +171,7 @@ subroutine ssavetxt(filename, d)
 ! call savetxt("log.txt", data)
 
 integer :: s, i
-open(newunit=s, file=filename, status="replace", action="write")
+s = open(filename, "w")
 do i = 1, size(d, 1)
     write(s, *) d(i, :)
 end do
@@ -187,7 +194,7 @@ subroutine dsavetxt(filename, d)
 ! call savetxt("log.txt", data)
 
 integer :: s, i
-open(newunit=s, file=filename, status="replace", action="write")
+s = open(filename, "w")
 do i = 1, size(d, 1)
     write(s, *) d(i, :)
 end do
@@ -210,7 +217,7 @@ subroutine qsavetxt(filename, d)
 ! call savetxt("log.txt", data)
 
 integer :: s, i
-open(newunit=s, file=filename, status="replace", action="write")
+s = open(filename, "w")
 do i = 1, size(d, 1)
     write(s, *) d(i, :)
 end do
@@ -268,4 +275,108 @@ logical function whitechar(char) ! white character
 end if
 end function
 
+integer function open(filename, mode) result(u)
+! Open a file
+!
+! To open a file to read:
+!
+! u = open("somefile.txt")        # The default `mode` is "rt"
+! u = open("somefile.txt", "r")
+!
+! To open a file to write:
+!
+! u = open("somefile.txt", "w")
+
+! To append to the end of the file if it exists:
+!
+! u = open("somefile.txt", "a")
+
+character(*), intent(in) :: filename
+character(*), intent(in), optional :: mode
+integer :: io
+character(3):: mode_
+character(:),allocatable :: action_, position_, status_, access_, form_
+
+
+mode_ = parse_mode(optval(mode, ""))
+
+if (mode_(1:2) == 'r ') then
+    action_='read'
+    position_='asis'
+    status_='old'
+else if (mode_(1:2) == 'w ') then
+    action_='write'
+    position_='asis'
+    status_='replace'
+else if (mode_(1:2) == 'a ') then
+    action_='write'
+    position_='append'
+    status_='old'
+else if (mode_(1:2) == 'x ') then
+    action_='write'
+    position_='asis'
+    status_='new'
+else if (mode_(1:2) == 'r+') then
+    action_='readwrite'
+    position_='asis'
+    status_='old'
+else if (mode_(1:2) == 'w+') then
+    action_='readwrite'
+    position_='asis'
+    status_='replace'
+else if (mode_(1:2) == 'a+') then
+    action_='readwrite'
+    position_='append'
+    status_='old'
+else if (mode_(1:2) == 'x+') then
+    action_='readwrite'
+    position_='asis'
+    status_='new'
+else
+    call error_stop("Unsupported mode: "//mode_(1:2))
+end if
+
+if (mode_(3:3) == 't') then
+    access_='sequential'
+    form_='formatted'
+else if (mode_(3:3) == 'b' .or. mode_(3:3) == 's') then
+    access_='stream'
+    form_='unformatted'
+else
+    call error_stop("Unsupported mode: "//mode_(3:3))
+endif
+
+open(newunit=u, file=filename, &
+     action = action_, position = position_, status = status_, &
+     access = access_, form = form_, &
+     iostat = io)
+
+end function
+
+character(3) function parse_mode(mode) result(mode_)
+character(*), intent(in) :: mode
+
+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) = '+'
+    else
+        mode_(3:3) = mode(2:2)
+    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 function
+
 end module

src/tests/CMakeLists.txt

@@ -1,5 +1,5 @@
 add_subdirectory(ascii)
-add_subdirectory(loadtxt)
+add_subdirectory(io)
 add_subdirectory(optval)
 
 add_executable(test_skip test_skip.f90)

src/tests/Makefile.manual

@@ -2,15 +2,15 @@
 
 all:
 	$(MAKE) -f Makefile.manual --directory=ascii
-	$(MAKE) -f Makefile.manual --directory=loadtxt
+	$(MAKE) -f Makefile.manual --directory=io
 	$(MAKE) -f Makefile.manual --directory=optval
 
 test:
 	$(MAKE) -f Makefile.manual --directory=ascii test
-	$(MAKE) -f Makefile.manual --directory=loadtxt test
+	$(MAKE) -f Makefile.manual --directory=io test
 	$(MAKE) -f Makefile.manual --directory=optval test
 
 clean:
 	$(MAKE) -f Makefile.manual --directory=ascii clean
-	$(MAKE) -f Makefile.manual --directory=loadtxt clean
+	$(MAKE) -f Makefile.manual --directory=io clean
 	$(MAKE) -f Makefile.manual --directory=optval clean

src/tests/loadtxt/CMakeLists.txt → src/tests/io/CMakeLists.txt

@@ -10,6 +10,9 @@ target_link_libraries(test_loadtxt_qp fortran_stdlib)
 add_executable(test_savetxt_qp test_savetxt_qp.f90)
 target_link_libraries(test_savetxt_qp fortran_stdlib)
 
+add_executable(test_open test_open.f90)
+target_link_libraries(test_open 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}
@@ -18,6 +21,8 @@ add_test(NAME loadtxt_qp COMMAND $<TARGET_FILE:test_loadtxt_qp> ${CMAKE_CURRENT_
   WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR})
 add_test(NAME savetxt_qp COMMAND $<TARGET_FILE:test_savetxt_qp> ${CMAKE_CURRENT_BINARY_DIR}
   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})
 
 set_tests_properties(loadtxt_qp PROPERTIES LABELS quadruple_precision)
 set_tests_properties(savetxt_qp PROPERTIES LABELS quadruple_precision)

src/tests/loadtxt/Makefile.manual → src/tests/io/Makefile.manual

@@ -1,9 +1,10 @@
 PROGS_SRC = test_loadtxt.f90 \
 			test_savetxt.f90 \
 			test_loadtxt_qp.f90 \
-			test_savetxt_qp.f90
+			test_savetxt_qp.f90 \
+			test_open.f90
 
-CLEAN_FILES = tmp.dat tmp_qp.dat
+CLEAN_FILES = tmp.dat tmp_qp.dat io_open.dat io_open.stream
 
 
 include ../Makefile.manual.test.mk

src/tests/io/test_open.f90

@@ -0,0 +1,119 @@
+program test_open
+use stdlib_experimental_io, only: open, parse_mode
+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"
+
+! Test mode "w"
+u = open(filename, "w")
+write(u, *) 1, 2, 3
+close(u)
+
+! Test mode "r"
+u = open(filename, "r")
+read(u, *) a
+call assert(all(a == [1, 2, 3]))
+close(u)
+
+! Test mode "a"
+u = open(filename, "a")
+write(u, *) 4, 5, 6
+close(u)
+u = open(filename, "r")
+read(u, *) a
+call assert(all(a == [1, 2, 3]))
+read(u, *) a
+call assert(all(a == [4, 5, 6]))
+close(u)
+
+
+
+! Stream file
+filename = get_outpath() // "/io_open.stream"
+
+! Test mode "w"
+u = open(filename, "wb")
+write(u) 1, 2, 3
+close(u)
+
+! Test mode "r"
+u = open(filename, "rb")
+read(u) a
+call assert(all(a == [1, 2, 3]))
+close(u)
+
+! Test mode "a"
+u = open(filename, "ab")
+write(u) 4, 5, 6
+close(u)
+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)
+
+contains
+
+    function get_outpath() result(outpath)
+    integer :: ierr
+    character(256) :: argv
+    character(:), allocatable :: outpath
+
+    call get_command_argument(1, argv, status=ierr)
+    if (ierr==0) then
+        outpath = trim(argv)
+    else
+        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