diff --git a/src/Makefile.manual b/src/Makefile.manual index f83c11aa7..31ca7cad7 100644 --- a/src/Makefile.manual +++ b/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 diff --git a/src/stdlib_experimental_io.f90 b/src/stdlib_experimental_io.f90 index ed93c63e1..91757f2a2 100644 --- a/src/stdlib_experimental_io.f90 +++ b/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 diff --git a/src/tests/CMakeLists.txt b/src/tests/CMakeLists.txt index 74f949c7c..12d7b39dd 100644 --- a/src/tests/CMakeLists.txt +++ b/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) diff --git a/src/tests/Makefile.manual b/src/tests/Makefile.manual index a7e59d196..5d2debb62 100644 --- a/src/tests/Makefile.manual +++ b/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 diff --git a/src/tests/loadtxt/CMakeLists.txt b/src/tests/io/CMakeLists.txt similarity index 83% rename from src/tests/loadtxt/CMakeLists.txt rename to src/tests/io/CMakeLists.txt index 5cef2a4f8..fb3d7179e 100644 --- a/src/tests/loadtxt/CMakeLists.txt +++ b/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 $ ${CMAKE_CURRENT_BINARY_DIR} WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}) add_test(NAME savetxt COMMAND $ ${CMAKE_CURRENT_BINARY_DIR} @@ -18,6 +21,8 @@ add_test(NAME loadtxt_qp COMMAND $ ${CMAKE_CURRENT_ WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}) add_test(NAME savetxt_qp COMMAND $ ${CMAKE_CURRENT_BINARY_DIR} WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}) +add_test(NAME open COMMAND $ ${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) diff --git a/src/tests/loadtxt/Makefile.manual b/src/tests/io/Makefile.manual similarity index 53% rename from src/tests/loadtxt/Makefile.manual rename to src/tests/io/Makefile.manual index 9cd8fe487..0e18c6aca 100644 --- a/src/tests/loadtxt/Makefile.manual +++ b/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 diff --git a/src/tests/loadtxt/array1.dat b/src/tests/io/array1.dat similarity index 100% rename from src/tests/loadtxt/array1.dat rename to src/tests/io/array1.dat diff --git a/src/tests/loadtxt/array2.dat b/src/tests/io/array2.dat similarity index 100% rename from src/tests/loadtxt/array2.dat rename to src/tests/io/array2.dat diff --git a/src/tests/loadtxt/array3.dat b/src/tests/io/array3.dat similarity index 100% rename from src/tests/loadtxt/array3.dat rename to src/tests/io/array3.dat diff --git a/src/tests/loadtxt/array4.dat b/src/tests/io/array4.dat similarity index 100% rename from src/tests/loadtxt/array4.dat rename to src/tests/io/array4.dat diff --git a/src/tests/loadtxt/test_loadtxt.f90 b/src/tests/io/test_loadtxt.f90 similarity index 100% rename from src/tests/loadtxt/test_loadtxt.f90 rename to src/tests/io/test_loadtxt.f90 diff --git a/src/tests/loadtxt/test_loadtxt_qp.f90 b/src/tests/io/test_loadtxt_qp.f90 similarity index 100% rename from src/tests/loadtxt/test_loadtxt_qp.f90 rename to src/tests/io/test_loadtxt_qp.f90 diff --git a/src/tests/io/test_open.f90 b/src/tests/io/test_open.f90 new file mode 100644 index 000000000..471c43952 --- /dev/null +++ b/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 diff --git a/src/tests/loadtxt/test_savetxt.f90 b/src/tests/io/test_savetxt.f90 similarity index 100% rename from src/tests/loadtxt/test_savetxt.f90 rename to src/tests/io/test_savetxt.f90 diff --git a/src/tests/loadtxt/test_savetxt_qp.f90 b/src/tests/io/test_savetxt_qp.f90 similarity index 100% rename from src/tests/loadtxt/test_savetxt_qp.f90 rename to src/tests/io/test_savetxt_qp.f90