From d760b5f066bfc550e08a0b8c1015a25985612bc9 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Mon, 16 Sep 2024 17:28:16 +0700 Subject: [PATCH 01/19] Extract filesystem interaction from big PR --- src/CMakeLists.txt | 12 ++ src/stdlib_io_filesystem.f90 | 112 ++++++++++++++++++ test/io/CMakeLists.txt | 1 + test/io/test_filesystem.f90 | 219 +++++++++++++++++++++++++++++++++++ 4 files changed, 344 insertions(+) create mode 100644 src/stdlib_io_filesystem.f90 create mode 100644 test/io/test_filesystem.f90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index ef11b642e..469abc456 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -109,6 +109,7 @@ set(SRC stdlib_hashmaps.f90 stdlib_hashmap_chaining.f90 stdlib_hashmap_open.f90 + stdlib_io_filesystem.f90 stdlib_logger.f90 stdlib_sorting_radix_sort.f90 stdlib_system.F90 @@ -120,6 +121,17 @@ set(SRC ${outPreprocFiles} ) +# Files that have cpp directives and need to be preprocessed. + set(hasCPP + stdlib_io_filesystem.f90 + ) + + if(CMAKE_Fortran_COMPILER_ID STREQUAL "GNU") + set_source_files_properties(${hasCPP} PROPERTIES COMPILE_FLAGS "-cpp") + elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "Intel") + set_source_files_properties(${hasCPP} PROPERTIES COMPILE_FLAGS "-fpp") + endif() + add_library(${PROJECT_NAME} ${SRC}) set_target_properties( diff --git a/src/stdlib_io_filesystem.f90 b/src/stdlib_io_filesystem.f90 new file mode 100644 index 000000000..a9f5b52d0 --- /dev/null +++ b/src/stdlib_io_filesystem.f90 @@ -0,0 +1,112 @@ +! SPDX-Identifier: MIT + + !> Interaction with the filesystem. +module stdlib_io_filesystem + use stdlib_string_type, only: string_type + implicit none + private + + public :: exists, list_dir, run, temp_dir + + character(*), parameter :: temp_dir = 'temp' + character(*), parameter :: listed_contents = temp_dir//'/listed_contents.txt' + +contains + + !> Version: experimental + !> + !> Whether a file or directory exists at the given path. + !> [Specification](../page/specs/stdlib_io.html#exists) + logical function exists(filename) + !> Name of the file or directory. + character(len=*), intent(in) :: filename + + inquire(file=filename, exist=exists) + +#if defined(__INTEL_COMPILER) + if (.not. exists) inquire(directory=filename, exist=exists) +#endif + end + + !> Version: experimental + !> + !> List files and directories of a directory. Does not list hidden files. + !> [Specification](../page/specs/stdlib_io.html#list_dir) + subroutine list_dir(dir, files, iostat, iomsg) + !> Directory to list. + character(len=*), intent(in) :: dir + !> List of files and directories. + type(string_type), allocatable, intent(out) :: files(:) + !> Status of listing. + integer, optional, intent(out) :: iostat + !> Error message. + character(len=:), allocatable, optional, intent(out) :: iomsg + + integer :: unit, stat + character(len=256) :: line + + stat = 0 + + if (.not. exists(temp_dir)) then + call run('mkdir '//temp_dir, stat) + if (stat /= 0) then + if (present(iostat)) iostat = stat + if (present(iomsg)) iomsg = "Failed to create temporary directory '"//temp_dir//"'." + return + end if + end if + + call run('ls '//dir//' > '//listed_contents, stat) + if (stat /= 0) then + if (present(iostat)) iostat = stat + if (present(iomsg)) iomsg = "Failed to list files in directory '"//dir//"'." + return + end if + + open(newunit=unit, file=listed_contents, status='old', action='read', iostat=stat) + if (stat /= 0) then + if (present(iostat)) iostat = stat + if (present(iomsg)) iomsg = "Failed to open file '"//listed_contents//"'." + return + end if + + allocate(files(0)) + do + read(unit, '(A)', iostat=stat) line + if (stat /= 0) exit + files = [files, string_type(line)] + end do + close(unit, status="delete") + end + + !> Version: experimental + !> + !> Run a command in the shell. + !> [Specification](../page/specs/stdlib_io.html#run) + subroutine run(command, iostat, iomsg) + !> Command to run. + character(len=*), intent(in) :: command + !> Status of the operation. + integer, intent(out), optional :: iostat + !> Error message. + character(len=:), allocatable, intent(out), optional :: iomsg + + integer :: exitstat, cmdstat + character(len=256) :: cmdmsg + + if (present(iostat)) iostat = 0 + exitstat = 0; cmdstat = 0 + + call execute_command_line(command, exitstat=exitstat, cmdstat=cmdstat, cmdmsg=cmdmsg) + if (exitstat /= 0 .or. cmdstat /= 0) then + if (present(iostat)) then + if (exitstat /= 0) then + iostat = exitstat + else + iostat = cmdstat + end if + end if + if (present(iomsg) .and. trim(adjustl(cmdmsg)) /= '') iomsg = cmdmsg + end if + end +end diff --git a/test/io/CMakeLists.txt b/test/io/CMakeLists.txt index 98794cd88..77a12c323 100644 --- a/test/io/CMakeLists.txt +++ b/test/io/CMakeLists.txt @@ -13,6 +13,7 @@ ADDTEST(savetxt_qp) set_tests_properties(loadtxt_qp PROPERTIES LABELS quadruple_precision) set_tests_properties(savetxt_qp PROPERTIES LABELS quadruple_precision) +ADDTEST(filesystem) ADDTEST(getline) ADDTEST(npy) ADDTEST(open) diff --git a/test/io/test_filesystem.f90 b/test/io/test_filesystem.f90 new file mode 100644 index 000000000..5b8aaeb68 --- /dev/null +++ b/test/io/test_filesystem.f90 @@ -0,0 +1,219 @@ +module test_filesystem + use stdlib_io_filesystem + use stdlib_string_type, only: char, string_type + use testdrive, only: new_unittest, unittest_type, error_type, check, test_failed + implicit none + private + + public :: collect_filesystem + + character(*), parameter :: temp_list_dir = 'temp_list_dir' + +contains + + !> Collect all exported unit tests + subroutine collect_filesystem(testsuite) + !> Collection of tests + type(unittest_type), allocatable, intent(out) :: testsuite(:) + + testsuite = [ & + new_unittest("fs_file_not_exists", fs_file_not_exists, should_fail=.true.), & + new_unittest("fs_file_exists", fs_file_exists), & + new_unittest("fs_current_dir_exists", fs_current_dir_exists), & + new_unittest("fs_run_invalid_command", fs_run_invalid_command, should_fail=.true.), & + new_unittest("fs_run_with_invalid_option", fs_run_with_invalid_option, should_fail=.true.), & + new_unittest("fs_run_valid_command", fs_run_valid_command), & + new_unittest("fs_list_dir_empty", fs_list_dir_empty), & + new_unittest("fs_list_dir_one_file", fs_list_dir_one_file), & + new_unittest("fs_list_dir_two_files", fs_list_dir_two_files) & + ] + end + + subroutine fs_file_not_exists(error) + type(error_type), allocatable, intent(out) :: error + + logical :: is_existing + + is_existing = exists("nonexistent") + call check(error, is_existing, "Non-existent file should fail.") + end + + subroutine fs_file_exists(error) + type(error_type), allocatable, intent(out) :: error + + logical :: is_existing + integer :: unit + character(*), parameter :: filename = "file.tmp" + + open(newunit=unit, file=filename) + close(unit) + + is_existing = exists(filename) + call check(error, is_existing, "An existing file should not fail.") + call delete_file(filename) + end + + subroutine fs_current_dir_exists(error) + type(error_type), allocatable, intent(out) :: error + + logical :: is_existing + + is_existing = exists(".") + call check(error, is_existing, "Current directory should not fail.") + end + + subroutine fs_run_invalid_command(error) + type(error_type), allocatable, intent(out) :: error + + integer :: stat + + call run("invalid_command", iostat=stat) + call check(error, stat, "Running an invalid command should fail.") + end + + subroutine fs_run_with_invalid_option(error) + type(error_type), allocatable, intent(out) :: error + + integer :: stat + + call run("whoami -X", iostat=stat) + call check(error, stat, "Running a valid command with an invalid option should fail.") + end + + subroutine fs_run_valid_command(error) + type(error_type), allocatable, intent(out) :: error + + integer :: stat + + call run("whoami", iostat=stat) + call check(error, stat, "Running a valid command should not fail.") + end + + subroutine fs_list_dir_empty(error) + type(error_type), allocatable, intent(out) :: error + + integer :: stat + type(string_type), allocatable :: files(:) + + call run('rm -rf '//temp_list_dir, iostat=stat) + if (stat /= 0) then + call test_failed(error, "Removing directory '"//temp_list_dir//"' failed."); return + end if + + call run('mkdir '//temp_list_dir, iostat=stat) + if (stat /= 0) then + call test_failed(error, "Creating directory '"//temp_list_dir//"' failed."); return + end if + + call list_dir(temp_list_dir, files, stat) + call check(error, stat, "Listing the contents of an empty directory shouldn't fail.") + call check(error, size(files) == 0, "The directory should be empty.") + + call run('rm -rf '//temp_list_dir, iostat=stat) + end + + subroutine fs_list_dir_one_file(error) + type(error_type), allocatable, intent(out) :: error + + integer :: stat + + type(string_type), allocatable :: files(:) + character(*), parameter :: filename = 'abc.txt' + + call run('rm -rf '//temp_list_dir, iostat=stat) + if (stat /= 0) then + call test_failed(error, "Removing directory '"//temp_list_dir//"' failed."); return + end if + + call run('mkdir '//temp_list_dir, iostat=stat) + if (stat /= 0) then + call test_failed(error, "Creating directory '"//temp_list_dir//"' failed."); return + end if + + call run('touch '//temp_list_dir//'/'//filename, iostat=stat) + if (stat /= 0) then + call test_failed(error, "Creating file'"//filename//"' in directory '"//temp_list_dir//"' failed."); return + end if + + call list_dir(temp_list_dir, files, stat) + call check(error, stat, "Listing the contents of an empty directory shouldn't fail.") + call check(error, size(files) == 1, "The directory should contain one file.") + call check(error, char(files(1)) == filename, "The file should be '"//filename//"'.") + + call run('rm -rf '//temp_list_dir, iostat=stat) + end + + subroutine fs_list_dir_two_files(error) + type(error_type), allocatable, intent(out) :: error + + integer :: stat + + type(string_type), allocatable :: files(:) + character(*), parameter :: filename1 = 'abc.txt' + character(*), parameter :: filename2 = 'xyz' + + call run('rm -rf '//temp_list_dir, iostat=stat) + if (stat /= 0) then + call test_failed(error, "Removing directory '"//temp_list_dir//"' failed."); return + end if + + call run('mkdir '//temp_list_dir, iostat=stat) + if (stat /= 0) then + call test_failed(error, "Creating directory '"//temp_list_dir//"' failed."); return + end if + + call run('touch '//temp_list_dir//'/'//filename1, iostat=stat) + if (stat /= 0) then + call test_failed(error, "Creating file 1 in directory '"//temp_list_dir//"' failed."); return + end if + + call run('touch '//temp_list_dir//'/'//filename2, iostat=stat) + if (stat /= 0) then + call test_failed(error, "Creating file 2 in directory '"//temp_list_dir//"' failed."); return + end if + + call list_dir(temp_list_dir, files, stat) + call check(error, stat, "Listing the contents of an empty directory shouldn't fail.") + call check(error, size(files) == 2, "The directory should contain two files.") + call check(error, char(files(1)) == filename1, "The file should be '"//filename1//"'.") + call check(error, char(files(2)) == filename2, "The file should be '"//filename2//"'.") + + call run('rm -rf '//temp_list_dir, iostat=stat) + end + + subroutine delete_file(filename) + character(len=*), intent(in) :: filename + + integer :: io + + open(newunit=io, file=filename) + close(io, status="delete") + end + +end + +program tester + use, intrinsic :: iso_fortran_env, only : error_unit + use testdrive, only : run_testsuite, new_testsuite, testsuite_type + use test_filesystem, only : collect_filesystem + implicit none + integer :: stat, is + type(testsuite_type), allocatable :: testsuites(:) + character(len=*), parameter :: fmt = '("#", *(1x, a))' + + stat = 0 + + testsuites = [ & + new_testsuite("filesystem", collect_filesystem) & + ] + + do is = 1, size(testsuites) + write(error_unit, fmt) "Testing:", testsuites(is)%name + call run_testsuite(testsuites(is)%collect, error_unit, stat) + end do + + if (stat > 0) then + write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!" + error stop + end if +end From 27b9eceb7af338f8ae6e25584219ce32255f69f7 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Mon, 16 Sep 2024 22:28:53 +0700 Subject: [PATCH 02/19] Add test that includes one dir --- test/io/test_filesystem.f90 | 41 ++++++++++++++++++++++++++++++++++++- 1 file changed, 40 insertions(+), 1 deletion(-) diff --git a/test/io/test_filesystem.f90 b/test/io/test_filesystem.f90 index 5b8aaeb68..bfcad3556 100644 --- a/test/io/test_filesystem.f90 +++ b/test/io/test_filesystem.f90 @@ -25,7 +25,8 @@ subroutine collect_filesystem(testsuite) new_unittest("fs_run_valid_command", fs_run_valid_command), & new_unittest("fs_list_dir_empty", fs_list_dir_empty), & new_unittest("fs_list_dir_one_file", fs_list_dir_one_file), & - new_unittest("fs_list_dir_two_files", fs_list_dir_two_files) & + new_unittest("fs_list_dir_two_files", fs_list_dir_two_files), & + new_unittest("fs_list_dir_one_file_one_dir", fs_list_dir_one_file_one_dir) & ] end @@ -181,6 +182,44 @@ subroutine fs_list_dir_two_files(error) call run('rm -rf '//temp_list_dir, iostat=stat) end + subroutine fs_list_dir_one_file_one_dir(error) + type(error_type), allocatable, intent(out) :: error + + integer :: stat + + type(string_type), allocatable :: contents(:) + character(*), parameter :: filename1 = 'abc.txt' + character(*), parameter :: dir = 'xyz' + + call run('rm -rf '//temp_list_dir, iostat=stat) + if (stat /= 0) then + call test_failed(error, "Removing directory '"//temp_list_dir//"' failed."); return + end if + + call run('mkdir '//temp_list_dir, iostat=stat) + if (stat /= 0) then + call test_failed(error, "Creating directory '"//temp_list_dir//"' failed."); return + end if + + call run('touch '//temp_list_dir//'/'//filename1, iostat=stat) + if (stat /= 0) then + call test_failed(error, "Creating file 1 in directory '"//temp_list_dir//"' failed."); return + end if + + call run('mkdir '//temp_list_dir//'/'//dir, iostat=stat) + if (stat /= 0) then + call test_failed(error, "Creating dir in directory '"//temp_list_dir//"' failed."); return + end if + + call list_dir(temp_list_dir, contents, stat) + call check(error, stat, "Listing the contents of an empty directory shouldn't fail.") + call check(error, size(contents) == 2, "The directory should contain two files.") + call check(error, char(contents(1)) == filename1, "The file should be '"//filename1//"'.") + call check(error, char(contents(2)) == dir, "The file should be '"//dir//"'.") + + call run('rm -rf '//temp_list_dir, iostat=stat) + end + subroutine delete_file(filename) character(len=*), intent(in) :: filename From 0dcfe432a7d1961d3a7eec8eea9946508761e34d Mon Sep 17 00:00:00 2001 From: minhqdao Date: Fri, 20 Sep 2024 17:44:18 +0700 Subject: [PATCH 03/19] Capitalize f90 --- src/CMakeLists.txt | 13 +------------ 1 file changed, 1 insertion(+), 12 deletions(-) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 469abc456..b96accf47 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -109,7 +109,7 @@ set(SRC stdlib_hashmaps.f90 stdlib_hashmap_chaining.f90 stdlib_hashmap_open.f90 - stdlib_io_filesystem.f90 + stdlib_io_filesystem.F90 stdlib_logger.f90 stdlib_sorting_radix_sort.f90 stdlib_system.F90 @@ -121,17 +121,6 @@ set(SRC ${outPreprocFiles} ) -# Files that have cpp directives and need to be preprocessed. - set(hasCPP - stdlib_io_filesystem.f90 - ) - - if(CMAKE_Fortran_COMPILER_ID STREQUAL "GNU") - set_source_files_properties(${hasCPP} PROPERTIES COMPILE_FLAGS "-cpp") - elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "Intel") - set_source_files_properties(${hasCPP} PROPERTIES COMPILE_FLAGS "-fpp") - endif() - add_library(${PROJECT_NAME} ${SRC}) set_target_properties( From 96593b5be58c56cacba6918deb534450f4acd913 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Fri, 20 Sep 2024 17:48:49 +0700 Subject: [PATCH 04/19] Let git recognize capitalization of file --- src/{stdlib_io_filesystem.f90 => stdlib_io_filesystem.F90} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename src/{stdlib_io_filesystem.f90 => stdlib_io_filesystem.F90} (100%) diff --git a/src/stdlib_io_filesystem.f90 b/src/stdlib_io_filesystem.F90 similarity index 100% rename from src/stdlib_io_filesystem.f90 rename to src/stdlib_io_filesystem.F90 From c1830df237323630bdc3d3424deac62d596e836c Mon Sep 17 00:00:00 2001 From: minhqdao Date: Fri, 20 Sep 2024 23:31:19 +0700 Subject: [PATCH 05/19] Add is_windows and test it --- src/stdlib_io_filesystem.F90 | 23 ++++++++++++++++++++++- test/io/test_filesystem.f90 | 15 +++++++++++++++ 2 files changed, 37 insertions(+), 1 deletion(-) diff --git a/src/stdlib_io_filesystem.F90 b/src/stdlib_io_filesystem.F90 index a9f5b52d0..1aa4d0711 100644 --- a/src/stdlib_io_filesystem.F90 +++ b/src/stdlib_io_filesystem.F90 @@ -6,13 +6,34 @@ module stdlib_io_filesystem implicit none private - public :: exists, list_dir, run, temp_dir + public :: temp_dir, is_windows, exists, list_dir, run character(*), parameter :: temp_dir = 'temp' character(*), parameter :: listed_contents = temp_dir//'/listed_contents.txt' contains + !> Version: experimental + !> + !> Whether the operating system is Windows. + !> [Specification](../page/specs/stdlib_io.html#is_windows) + logical function is_windows() + character(len=255) :: value + integer :: length, stat + + call get_environment_variable('OSTYPE', value, length, stat) + if (stat == 0 .and. length > 0 .and. (index(value, 'win') > 0 .or. index(value, 'msys') > 0)) then + is_windows = .true.; return + end if + + call get_environment_variable('OS', value, length, stat) + if (stat == 0 .and. length > 0 .and. index(value, 'Windows_NT') > 0) then + is_windows = .true.; return + end if + + is_windows = .false. + end + !> Version: experimental !> !> Whether a file or directory exists at the given path. diff --git a/test/io/test_filesystem.f90 b/test/io/test_filesystem.f90 index bfcad3556..4b2323fbe 100644 --- a/test/io/test_filesystem.f90 +++ b/test/io/test_filesystem.f90 @@ -17,6 +17,7 @@ subroutine collect_filesystem(testsuite) type(unittest_type), allocatable, intent(out) :: testsuite(:) testsuite = [ & + new_unittest("fs_file_is_windows", fs_is_windows), & new_unittest("fs_file_not_exists", fs_file_not_exists, should_fail=.true.), & new_unittest("fs_file_exists", fs_file_exists), & new_unittest("fs_current_dir_exists", fs_current_dir_exists), & @@ -30,6 +31,20 @@ subroutine collect_filesystem(testsuite) ] end + subroutine fs_is_windows(error) + type(error_type), allocatable, intent(out) :: error + + character(len=255) :: value + integer :: length, stat + + call get_environment_variable('HOMEDRIVE', value, length, stat) + if (is_windows()) then + call check(error, stat == 0 .and. length > 0, "Windows should be detected.") + else + call check(error, stat /= 0 .and. length == 0, "Windows should not be detected.") + end if + end + subroutine fs_file_not_exists(error) type(error_type), allocatable, intent(out) :: error From 84f36f149f284473d1336a775329a40447c43646 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Fri, 20 Sep 2024 23:52:00 +0700 Subject: [PATCH 06/19] Use Windows-specific commands and fix tests --- src/stdlib_io_filesystem.F90 | 15 +++++++++------ test/io/test_filesystem.f90 | 6 +++++- 2 files changed, 14 insertions(+), 7 deletions(-) diff --git a/src/stdlib_io_filesystem.F90 b/src/stdlib_io_filesystem.F90 index 1aa4d0711..2dd477abd 100644 --- a/src/stdlib_io_filesystem.F90 +++ b/src/stdlib_io_filesystem.F90 @@ -68,13 +68,16 @@ subroutine list_dir(dir, files, iostat, iomsg) stat = 0 - if (.not. exists(temp_dir)) then + if (is_windows()) then call run('mkdir '//temp_dir, stat) - if (stat /= 0) then - if (present(iostat)) iostat = stat - if (present(iomsg)) iomsg = "Failed to create temporary directory '"//temp_dir//"'." - return - end if + else + call run('mkdir -p '//temp_dir, stat) + end if + + if (stat /= 0) then + if (present(iostat)) iostat = stat + if (present(iomsg)) iomsg = "Failed to create temporary directory '"//temp_dir//"'." + return end if call run('ls '//dir//' > '//listed_contents, stat) diff --git a/test/io/test_filesystem.f90 b/test/io/test_filesystem.f90 index 4b2323fbe..cd3b74a37 100644 --- a/test/io/test_filesystem.f90 +++ b/test/io/test_filesystem.f90 @@ -221,7 +221,11 @@ subroutine fs_list_dir_one_file_one_dir(error) call test_failed(error, "Creating file 1 in directory '"//temp_list_dir//"' failed."); return end if - call run('mkdir '//temp_list_dir//'/'//dir, iostat=stat) + if (is_windows()) then + call run('mkdir '//temp_list_dir//'\'//dir, iostat=stat) + else + call run('mkdir '//temp_list_dir//'/'//dir, iostat=stat) + end if if (stat /= 0) then call test_failed(error, "Creating dir in directory '"//temp_list_dir//"' failed."); return end if From 0642aff493fc37258ed00b157ec53b962ca8ba06 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sat, 21 Sep 2024 00:12:03 +0700 Subject: [PATCH 07/19] Check for existence again --- src/stdlib_io_filesystem.F90 | 15 ++++++--------- 1 file changed, 6 insertions(+), 9 deletions(-) diff --git a/src/stdlib_io_filesystem.F90 b/src/stdlib_io_filesystem.F90 index 2dd477abd..1aa4d0711 100644 --- a/src/stdlib_io_filesystem.F90 +++ b/src/stdlib_io_filesystem.F90 @@ -68,16 +68,13 @@ subroutine list_dir(dir, files, iostat, iomsg) stat = 0 - if (is_windows()) then + if (.not. exists(temp_dir)) then call run('mkdir '//temp_dir, stat) - else - call run('mkdir -p '//temp_dir, stat) - end if - - if (stat /= 0) then - if (present(iostat)) iostat = stat - if (present(iomsg)) iomsg = "Failed to create temporary directory '"//temp_dir//"'." - return + if (stat /= 0) then + if (present(iostat)) iostat = stat + if (present(iomsg)) iomsg = "Failed to create temporary directory '"//temp_dir//"'." + return + end if end if call run('ls '//dir//' > '//listed_contents, stat) From e58f4b8a6f1b93ac093677020b43fd0e71bbe6a8 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sat, 21 Sep 2024 00:51:12 +0700 Subject: [PATCH 08/19] Add rm_dir and test it --- src/stdlib_io_filesystem.F90 | 16 +++++++++++++++- test/io/test_filesystem.f90 | 36 ++++++++++++++++++++++++++++++++++-- 2 files changed, 49 insertions(+), 3 deletions(-) diff --git a/src/stdlib_io_filesystem.F90 b/src/stdlib_io_filesystem.F90 index 1aa4d0711..f3ea2d304 100644 --- a/src/stdlib_io_filesystem.F90 +++ b/src/stdlib_io_filesystem.F90 @@ -6,7 +6,7 @@ module stdlib_io_filesystem implicit none private - public :: temp_dir, is_windows, exists, list_dir, run + public :: temp_dir, is_windows, exists, list_dir, rm_dir, run character(*), parameter :: temp_dir = 'temp' character(*), parameter :: listed_contents = temp_dir//'/listed_contents.txt' @@ -100,6 +100,20 @@ subroutine list_dir(dir, files, iostat, iomsg) close(unit, status="delete") end + !> Version: experimental + !> + !> Remove a directory and its contents. + !> [Specification](../page/specs/stdlib_io.html#rm_dir) + subroutine rm_dir(dir) + character(len=*), intent(in) :: dir + + if (is_windows()) then + call run('rmdir /s/q '//dir) + else + call run('rm -rf '//dir) + end if + end + !> Version: experimental !> !> Run a command in the shell. diff --git a/test/io/test_filesystem.f90 b/test/io/test_filesystem.f90 index cd3b74a37..2a2f7deeb 100644 --- a/test/io/test_filesystem.f90 +++ b/test/io/test_filesystem.f90 @@ -27,7 +27,9 @@ subroutine collect_filesystem(testsuite) new_unittest("fs_list_dir_empty", fs_list_dir_empty), & new_unittest("fs_list_dir_one_file", fs_list_dir_one_file), & new_unittest("fs_list_dir_two_files", fs_list_dir_two_files), & - new_unittest("fs_list_dir_one_file_one_dir", fs_list_dir_one_file_one_dir) & + new_unittest("fs_list_dir_one_file_one_dir", fs_list_dir_one_file_one_dir), & + new_unittest("fs_rm_dir_empty", fs_rm_dir_empty), & + new_unittest("fs_rm_dir_with_contents", fs_rm_dir_with_contents) & ] end @@ -239,6 +241,37 @@ subroutine fs_list_dir_one_file_one_dir(error) call run('rm -rf '//temp_list_dir, iostat=stat) end + subroutine fs_rm_dir_empty(error) + type(error_type), allocatable, intent(out) :: error + + character(*), parameter :: filename = "empty_dir_to_remove" + + call rm_dir(filename) + call check(error, .not. exists(filename), "Directory should not exist.") + call run('mkdir '//filename) + call check(error, exists(filename), "Directory should exist.") + call rm_dir(filename) + call check(error, .not. exists(filename), "Directory should not exist.") + end + + subroutine fs_rm_dir_with_contents(error) + type(error_type), allocatable, intent(out) :: error + + character(*), parameter :: filename = "dir_with_contents_to_remove" + + call rm_dir(filename) + call check(error, .not. exists(filename), "Directory should not exist.") + call run('mkdir '//filename) + call check(error, exists(filename), "Directory should exist.") + if (is_windows()) then + call run('mkdir '//filename//'\'//'another_dir') + else + call run('mkdir '//filename//'/'//'another_dir') + end if + call rm_dir(filename) + call check(error, .not. exists(filename), "Directory should not exist.") + end + subroutine delete_file(filename) character(len=*), intent(in) :: filename @@ -247,7 +280,6 @@ subroutine delete_file(filename) open(newunit=io, file=filename) close(io, status="delete") end - end program tester From 7e91c7cb533c62b418a6ce1027e5bc35b36514c5 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sat, 21 Sep 2024 01:05:25 +0700 Subject: [PATCH 09/19] Remove all rm -rf --- src/stdlib_io_filesystem.F90 | 2 +- test/io/test_filesystem.f90 | 32 ++++++++------------------------ 2 files changed, 9 insertions(+), 25 deletions(-) diff --git a/src/stdlib_io_filesystem.F90 b/src/stdlib_io_filesystem.F90 index f3ea2d304..7f31fd5cb 100644 --- a/src/stdlib_io_filesystem.F90 +++ b/src/stdlib_io_filesystem.F90 @@ -102,7 +102,7 @@ subroutine list_dir(dir, files, iostat, iomsg) !> Version: experimental !> - !> Remove a directory and its contents. + !> Remove a directory including its contents. !> [Specification](../page/specs/stdlib_io.html#rm_dir) subroutine rm_dir(dir) character(len=*), intent(in) :: dir diff --git a/test/io/test_filesystem.f90 b/test/io/test_filesystem.f90 index 2a2f7deeb..1d1e88651 100644 --- a/test/io/test_filesystem.f90 +++ b/test/io/test_filesystem.f90 @@ -113,11 +113,7 @@ subroutine fs_list_dir_empty(error) integer :: stat type(string_type), allocatable :: files(:) - call run('rm -rf '//temp_list_dir, iostat=stat) - if (stat /= 0) then - call test_failed(error, "Removing directory '"//temp_list_dir//"' failed."); return - end if - + call rm_dir(temp_list_dir) call run('mkdir '//temp_list_dir, iostat=stat) if (stat /= 0) then call test_failed(error, "Creating directory '"//temp_list_dir//"' failed."); return @@ -127,7 +123,7 @@ subroutine fs_list_dir_empty(error) call check(error, stat, "Listing the contents of an empty directory shouldn't fail.") call check(error, size(files) == 0, "The directory should be empty.") - call run('rm -rf '//temp_list_dir, iostat=stat) + call rm_dir(temp_list_dir) end subroutine fs_list_dir_one_file(error) @@ -138,11 +134,7 @@ subroutine fs_list_dir_one_file(error) type(string_type), allocatable :: files(:) character(*), parameter :: filename = 'abc.txt' - call run('rm -rf '//temp_list_dir, iostat=stat) - if (stat /= 0) then - call test_failed(error, "Removing directory '"//temp_list_dir//"' failed."); return - end if - + call rm_dir(temp_list_dir) call run('mkdir '//temp_list_dir, iostat=stat) if (stat /= 0) then call test_failed(error, "Creating directory '"//temp_list_dir//"' failed."); return @@ -158,7 +150,7 @@ subroutine fs_list_dir_one_file(error) call check(error, size(files) == 1, "The directory should contain one file.") call check(error, char(files(1)) == filename, "The file should be '"//filename//"'.") - call run('rm -rf '//temp_list_dir, iostat=stat) + call rm_dir(temp_list_dir) end subroutine fs_list_dir_two_files(error) @@ -170,11 +162,7 @@ subroutine fs_list_dir_two_files(error) character(*), parameter :: filename1 = 'abc.txt' character(*), parameter :: filename2 = 'xyz' - call run('rm -rf '//temp_list_dir, iostat=stat) - if (stat /= 0) then - call test_failed(error, "Removing directory '"//temp_list_dir//"' failed."); return - end if - + call rm_dir(temp_list_dir) call run('mkdir '//temp_list_dir, iostat=stat) if (stat /= 0) then call test_failed(error, "Creating directory '"//temp_list_dir//"' failed."); return @@ -196,7 +184,7 @@ subroutine fs_list_dir_two_files(error) call check(error, char(files(1)) == filename1, "The file should be '"//filename1//"'.") call check(error, char(files(2)) == filename2, "The file should be '"//filename2//"'.") - call run('rm -rf '//temp_list_dir, iostat=stat) + call rm_dir(temp_list_dir) end subroutine fs_list_dir_one_file_one_dir(error) @@ -208,11 +196,7 @@ subroutine fs_list_dir_one_file_one_dir(error) character(*), parameter :: filename1 = 'abc.txt' character(*), parameter :: dir = 'xyz' - call run('rm -rf '//temp_list_dir, iostat=stat) - if (stat /= 0) then - call test_failed(error, "Removing directory '"//temp_list_dir//"' failed."); return - end if - + call rm_dir(temp_list_dir) call run('mkdir '//temp_list_dir, iostat=stat) if (stat /= 0) then call test_failed(error, "Creating directory '"//temp_list_dir//"' failed."); return @@ -238,7 +222,7 @@ subroutine fs_list_dir_one_file_one_dir(error) call check(error, char(contents(1)) == filename1, "The file should be '"//filename1//"'.") call check(error, char(contents(2)) == dir, "The file should be '"//dir//"'.") - call run('rm -rf '//temp_list_dir, iostat=stat) + call rm_dir(temp_list_dir) end subroutine fs_rm_dir_empty(error) From 21739b78c5a2ff39c9bdebcdd1dd16ed15d3c00e Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sat, 21 Sep 2024 02:09:45 +0700 Subject: [PATCH 10/19] Use dir /b on Windows --- src/stdlib_io_filesystem.F90 | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/stdlib_io_filesystem.F90 b/src/stdlib_io_filesystem.F90 index 7f31fd5cb..f9e2671de 100644 --- a/src/stdlib_io_filesystem.F90 +++ b/src/stdlib_io_filesystem.F90 @@ -77,7 +77,11 @@ subroutine list_dir(dir, files, iostat, iomsg) end if end if - call run('ls '//dir//' > '//listed_contents, stat) + if (is_windows()) then + call run('dir /b '//dir//' > '//listed_contents, stat) + else + call run('ls '//dir//' > '//listed_contents, stat) + end if if (stat /= 0) then if (present(iostat)) iostat = stat if (present(iomsg)) iomsg = "Failed to list files in directory '"//dir//"'." From eeeb6345068d0eedff13345e57b488d23f77b8d7 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sat, 21 Sep 2024 02:21:41 +0700 Subject: [PATCH 11/19] Add mkdir subroutine --- src/stdlib_io_filesystem.F90 | 24 ++++++++++--- test/io/test_filesystem.f90 | 68 ++++++++++++++++++------------------ 2 files changed, 54 insertions(+), 38 deletions(-) diff --git a/src/stdlib_io_filesystem.F90 b/src/stdlib_io_filesystem.F90 index f9e2671de..807c7923a 100644 --- a/src/stdlib_io_filesystem.F90 +++ b/src/stdlib_io_filesystem.F90 @@ -6,7 +6,7 @@ module stdlib_io_filesystem implicit none private - public :: temp_dir, is_windows, exists, list_dir, rm_dir, run + public :: temp_dir, is_windows, exists, list_dir, mkdir, rmdir, run character(*), parameter :: temp_dir = 'temp' character(*), parameter :: listed_contents = temp_dir//'/listed_contents.txt' @@ -69,7 +69,7 @@ subroutine list_dir(dir, files, iostat, iomsg) stat = 0 if (.not. exists(temp_dir)) then - call run('mkdir '//temp_dir, stat) + call mkdir(temp_dir, stat) if (stat /= 0) then if (present(iostat)) iostat = stat if (present(iomsg)) iomsg = "Failed to create temporary directory '"//temp_dir//"'." @@ -104,11 +104,27 @@ subroutine list_dir(dir, files, iostat, iomsg) close(unit, status="delete") end + !> Version: experimental + !> + !> Create a directory. + !> [Specification](../page/specs/stdlib_io.html#mkdir) + subroutine mkdir(dir, iostat, iomsg) + character(len=*), intent(in) :: dir + integer, optional, intent(out) :: iostat + character(len=:), allocatable, optional, intent(out) :: iomsg + + if (is_windows()) then + call run('mkdir '//dir, iostat, iomsg) + else + call run('mkdir -p '//dir, iostat, iomsg) + end if + end + !> Version: experimental !> !> Remove a directory including its contents. - !> [Specification](../page/specs/stdlib_io.html#rm_dir) - subroutine rm_dir(dir) + !> [Specification](../page/specs/stdlib_io.html#rmdir) + subroutine rmdir(dir) character(len=*), intent(in) :: dir if (is_windows()) then diff --git a/test/io/test_filesystem.f90 b/test/io/test_filesystem.f90 index 1d1e88651..3f84589cd 100644 --- a/test/io/test_filesystem.f90 +++ b/test/io/test_filesystem.f90 @@ -28,8 +28,8 @@ subroutine collect_filesystem(testsuite) new_unittest("fs_list_dir_one_file", fs_list_dir_one_file), & new_unittest("fs_list_dir_two_files", fs_list_dir_two_files), & new_unittest("fs_list_dir_one_file_one_dir", fs_list_dir_one_file_one_dir), & - new_unittest("fs_rm_dir_empty", fs_rm_dir_empty), & - new_unittest("fs_rm_dir_with_contents", fs_rm_dir_with_contents) & + new_unittest("fs_rmdir_empty", fs_rmdir_empty), & + new_unittest("fs_rmdir_with_contents", fs_rmdir_with_contents) & ] end @@ -113,8 +113,8 @@ subroutine fs_list_dir_empty(error) integer :: stat type(string_type), allocatable :: files(:) - call rm_dir(temp_list_dir) - call run('mkdir '//temp_list_dir, iostat=stat) + call rmdir(temp_list_dir) + call mkdir(temp_list_dir, stat) if (stat /= 0) then call test_failed(error, "Creating directory '"//temp_list_dir//"' failed."); return end if @@ -123,7 +123,7 @@ subroutine fs_list_dir_empty(error) call check(error, stat, "Listing the contents of an empty directory shouldn't fail.") call check(error, size(files) == 0, "The directory should be empty.") - call rm_dir(temp_list_dir) + call rmdir(temp_list_dir) end subroutine fs_list_dir_one_file(error) @@ -134,8 +134,8 @@ subroutine fs_list_dir_one_file(error) type(string_type), allocatable :: files(:) character(*), parameter :: filename = 'abc.txt' - call rm_dir(temp_list_dir) - call run('mkdir '//temp_list_dir, iostat=stat) + call rmdir(temp_list_dir) + call mkdir(temp_list_dir, stat) if (stat /= 0) then call test_failed(error, "Creating directory '"//temp_list_dir//"' failed."); return end if @@ -150,7 +150,7 @@ subroutine fs_list_dir_one_file(error) call check(error, size(files) == 1, "The directory should contain one file.") call check(error, char(files(1)) == filename, "The file should be '"//filename//"'.") - call rm_dir(temp_list_dir) + call rmdir(temp_list_dir) end subroutine fs_list_dir_two_files(error) @@ -162,8 +162,8 @@ subroutine fs_list_dir_two_files(error) character(*), parameter :: filename1 = 'abc.txt' character(*), parameter :: filename2 = 'xyz' - call rm_dir(temp_list_dir) - call run('mkdir '//temp_list_dir, iostat=stat) + call rmdir(temp_list_dir) + call mkdir(temp_list_dir, stat) if (stat /= 0) then call test_failed(error, "Creating directory '"//temp_list_dir//"' failed."); return end if @@ -184,7 +184,7 @@ subroutine fs_list_dir_two_files(error) call check(error, char(files(1)) == filename1, "The file should be '"//filename1//"'.") call check(error, char(files(2)) == filename2, "The file should be '"//filename2//"'.") - call rm_dir(temp_list_dir) + call rmdir(temp_list_dir) end subroutine fs_list_dir_one_file_one_dir(error) @@ -196,8 +196,8 @@ subroutine fs_list_dir_one_file_one_dir(error) character(*), parameter :: filename1 = 'abc.txt' character(*), parameter :: dir = 'xyz' - call rm_dir(temp_list_dir) - call run('mkdir '//temp_list_dir, iostat=stat) + call rmdir(temp_list_dir) + call mkdir(temp_list_dir, stat) if (stat /= 0) then call test_failed(error, "Creating directory '"//temp_list_dir//"' failed."); return end if @@ -208,9 +208,9 @@ subroutine fs_list_dir_one_file_one_dir(error) end if if (is_windows()) then - call run('mkdir '//temp_list_dir//'\'//dir, iostat=stat) + call mkdir(temp_list_dir//'\'//dir, stat) else - call run('mkdir '//temp_list_dir//'/'//dir, iostat=stat) + call mkdir(temp_list_dir//'/'//dir, stat) end if if (stat /= 0) then call test_failed(error, "Creating dir in directory '"//temp_list_dir//"' failed."); return @@ -222,38 +222,38 @@ subroutine fs_list_dir_one_file_one_dir(error) call check(error, char(contents(1)) == filename1, "The file should be '"//filename1//"'.") call check(error, char(contents(2)) == dir, "The file should be '"//dir//"'.") - call rm_dir(temp_list_dir) + call rmdir(temp_list_dir) end - subroutine fs_rm_dir_empty(error) + subroutine fs_rmdir_empty(error) type(error_type), allocatable, intent(out) :: error - character(*), parameter :: filename = "empty_dir_to_remove" + character(*), parameter :: dir = "empty_dir_to_remove" - call rm_dir(filename) - call check(error, .not. exists(filename), "Directory should not exist.") - call run('mkdir '//filename) - call check(error, exists(filename), "Directory should exist.") - call rm_dir(filename) - call check(error, .not. exists(filename), "Directory should not exist.") + call rmdir(dir) + call check(error, .not. exists(dir), "Directory should not exist.") + call mkdir(dir) + call check(error, exists(dir), "Directory should exist.") + call rmdir(dir) + call check(error, .not. exists(dir), "Directory should not exist.") end - subroutine fs_rm_dir_with_contents(error) + subroutine fs_rmdir_with_contents(error) type(error_type), allocatable, intent(out) :: error - character(*), parameter :: filename = "dir_with_contents_to_remove" + character(*), parameter :: dir = "dir_with_contents_to_remove" - call rm_dir(filename) - call check(error, .not. exists(filename), "Directory should not exist.") - call run('mkdir '//filename) - call check(error, exists(filename), "Directory should exist.") + call rmdir(dir) + call check(error, .not. exists(dir), "Directory should not exist.") + call mkdir(dir) + call check(error, exists(dir), "Directory should exist.") if (is_windows()) then - call run('mkdir '//filename//'\'//'another_dir') + call mkdir(dir//'\'//'another_dir') else - call run('mkdir '//filename//'/'//'another_dir') + call mkdir(dir//'/'//'another_dir') end if - call rm_dir(filename) - call check(error, .not. exists(filename), "Directory should not exist.") + call rmdir(dir) + call check(error, .not. exists(dir), "Directory should not exist.") end subroutine delete_file(filename) From 9da3ea725718adaa8ad10bee0ab6b6bf112a326b Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sat, 21 Sep 2024 11:14:46 +0700 Subject: [PATCH 12/19] Add path_separator() with tests --- src/stdlib_io_filesystem.F90 | 18 ++++++++++++++++-- test/io/test_filesystem.f90 | 16 ++++++++++++++++ 2 files changed, 32 insertions(+), 2 deletions(-) diff --git a/src/stdlib_io_filesystem.F90 b/src/stdlib_io_filesystem.F90 index 807c7923a..61a69a66e 100644 --- a/src/stdlib_io_filesystem.F90 +++ b/src/stdlib_io_filesystem.F90 @@ -6,10 +6,9 @@ module stdlib_io_filesystem implicit none private - public :: temp_dir, is_windows, exists, list_dir, mkdir, rmdir, run + public :: temp_dir, is_windows, exists, path_separator, list_dir, mkdir, rmdir, run character(*), parameter :: temp_dir = 'temp' - character(*), parameter :: listed_contents = temp_dir//'/listed_contents.txt' contains @@ -34,6 +33,18 @@ logical function is_windows() is_windows = .false. end + !> Version: experimental + !> + !> Separator for paths. + !> [Specification](../page/specs/stdlib_io.html#path_separator) + character function path_separator() + if (is_windows()) then + path_separator = '\' + else + path_separator = '/' + end if + end + !> Version: experimental !> !> Whether a file or directory exists at the given path. @@ -65,6 +76,7 @@ subroutine list_dir(dir, files, iostat, iomsg) integer :: unit, stat character(len=256) :: line + character(:), allocatable :: listed_contents stat = 0 @@ -77,6 +89,8 @@ subroutine list_dir(dir, files, iostat, iomsg) end if end if + listed_contents = temp_dir//path_separator()//'listed_contents.txt' + if (is_windows()) then call run('dir /b '//dir//' > '//listed_contents, stat) else diff --git a/test/io/test_filesystem.f90 b/test/io/test_filesystem.f90 index 3f84589cd..44b846525 100644 --- a/test/io/test_filesystem.f90 +++ b/test/io/test_filesystem.f90 @@ -21,6 +21,7 @@ subroutine collect_filesystem(testsuite) new_unittest("fs_file_not_exists", fs_file_not_exists, should_fail=.true.), & new_unittest("fs_file_exists", fs_file_exists), & new_unittest("fs_current_dir_exists", fs_current_dir_exists), & + new_unittest("fs_path_separator", fs_path_separator), & new_unittest("fs_run_invalid_command", fs_run_invalid_command, should_fail=.true.), & new_unittest("fs_run_with_invalid_option", fs_run_with_invalid_option, should_fail=.true.), & new_unittest("fs_run_valid_command", fs_run_valid_command), & @@ -80,6 +81,21 @@ subroutine fs_current_dir_exists(error) call check(error, is_existing, "Current directory should not fail.") end + subroutine fs_path_separator(error) + type(error_type), allocatable, intent(out) :: error + + character(*), parameter :: outer_dir = "path_separator_outer" + character(*), parameter :: inner_dir = "path_separator_inner" + + call rmdir(outer_dir) + call check(error, .not. exists(outer_dir), "Directory should not exist.") + call mkdir(outer_dir) + call check(error, exists(outer_dir), "Outer directory should now exist.") + call mkdir(outer_dir//path_separator()//inner_dir) + call check(error, exists(outer_dir//path_separator()//inner_dir), "Inner directory should now exist.") + call rmdir(outer_dir) + end + subroutine fs_run_invalid_command(error) type(error_type), allocatable, intent(out) :: error From d913f93737d933487d79446e03cc79dafed1b13e Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sat, 21 Sep 2024 14:20:46 +0700 Subject: [PATCH 13/19] Add docs --- doc/specs/stdlib_io.md | 144 ++++++++++++++++++++++++++++++++++- src/stdlib_io_filesystem.F90 | 12 +-- 2 files changed, 149 insertions(+), 7 deletions(-) diff --git a/doc/specs/stdlib_io.md b/doc/specs/stdlib_io.md index 8c868802a..9e992c627 100644 --- a/doc/specs/stdlib_io.md +++ b/doc/specs/stdlib_io.md @@ -123,6 +123,149 @@ Provides a text file called `filename` that contains the rank-2 `array`. {!example/io/example_savetxt.f90!} ``` +## `is_windows` + +### Status + +Experimental + +### Description + +Returns a logical value indicating whether the current operating system is Windows. + +### Syntax + +`is_windows = ` [[stdlib_io_filesystem(module):is_windows(function)]] `()` + +### Return value + +A logical value indicating whether the current operating system is Windows. + +## `path_separator` + +### Status + +Experimental + +### Description + +Returns the path separator for the current operating system. + +### Syntax + +`separator = ` [[stdlib_io_filesystem(module):path_separator(function)]] `()` + +### Return value + +A character value containing the path separator for the current operating system. + +## `exists` + +### Status + +Experimental + +### Description + +Determines if a file or directory exists at the given path by returning a logical value. + +### Syntax + +`exists = ` [[stdlib_io_filesystem(module):exists(function)]] `(path)` + +### Arguments + +`path`: Shall be a character expression containing the path to a file or directory to check for existence. + +### Return value + +A logical value indicating whether a file or directory exists at the given path. + +## `list_dir` + +### Status + +Experimental + +### Description + +Lists the contents of a directory. + +### Syntax + +`call ` [[stdlib_io_filesystem(module):list_dir(subroutine)]] `(dir, files[, iostat][, iomsg])` + +### Arguments + +`dir`: Shall be a character expression containing the path to the directory to list. + +`files`: Shall be an allocatable rank-1 array of type `string_type` that will contain the names of the files and directories in the directory. + +`iostat`: Shall be a scalar of type `integer` that receives the error status of `list_dir`. Optional argument. + +`iomsg`: Shall be a deferred length character variable that receives the error message of `list_dir`. Optional argument. + +## `mkdir` + +### Status + +Experimental + +### Description + +Creates a new directory. + +### Syntax + +`call ` [[stdlib_io_filesystem(module):mkdir(subroutine)]] `(dir[, iostat][, iomsg])` + +### Arguments + +`dir`: Shall be a character expression containing the path to the directory to create. + +`iostat`: Shall be a scalar of type `integer` that receives the error status of `mkdir`. Optional argument. + +`iomsg`: Shall be a deferred length character variable that receives the error message of `mkdir`. Optional argument. + +## `rmdir` + +### Status + +Experimental + +### Description + +Removes a directory. + +### Syntax + +`call ` [[stdlib_io_filesystem(module):rmdir(subroutine)]] `(dir)` + +### Arguments + +`dir`: Shall be a character expression containing the path to the directory to remove. + +## `run` + +### Status + +Experimental + +### Description + +Runs a command in the shell. + +### Syntax + +`call ` [[stdlib_io_filesystem(module):run(subroutine)]] `(command[, iostat][, iomsg])` + +### Arguments + +`command`: Shall be a character expression containing the command to run in the shell. + +`iostat`: Shall be a scalar of type `integer` that receives the error status of `run`. Optional argument. + +`iomsg`: Shall be a deferred length character variable that receives the error message of `run`. Optional argument. ## `load_npy` @@ -164,7 +307,6 @@ Returns an allocated `array` with the content of `filename` in case of success. {!example/io/example_loadnpy.f90!} ``` - ## `save_npy` ### Status diff --git a/src/stdlib_io_filesystem.F90 b/src/stdlib_io_filesystem.F90 index 61a69a66e..3cb8dba51 100644 --- a/src/stdlib_io_filesystem.F90 +++ b/src/stdlib_io_filesystem.F90 @@ -35,7 +35,7 @@ logical function is_windows() !> Version: experimental !> - !> Separator for paths. + !> Returns the path separator for the current operating system. !> [Specification](../page/specs/stdlib_io.html#path_separator) character function path_separator() if (is_windows()) then @@ -49,14 +49,14 @@ character function path_separator() !> !> Whether a file or directory exists at the given path. !> [Specification](../page/specs/stdlib_io.html#exists) - logical function exists(filename) - !> Name of the file or directory. - character(len=*), intent(in) :: filename + logical function exists(path) + !> Path to a file or directory. + character(len=*), intent(in) :: path - inquire(file=filename, exist=exists) + inquire(file=path, exist=exists) #if defined(__INTEL_COMPILER) - if (.not. exists) inquire(directory=filename, exist=exists) + if (.not. exists) inquire(directory=path, exist=exists) #endif end From 91199702b50f9a99cde0dfdb4c585492b11598cd Mon Sep 17 00:00:00 2001 From: minhqdao Date: Tue, 8 Oct 2024 22:58:54 +0700 Subject: [PATCH 14/19] Annotate what we are ending --- src/stdlib_io_filesystem.F90 | 16 ++++++++-------- test/io/test_filesystem.f90 | 36 ++++++++++++++++++------------------ 2 files changed, 26 insertions(+), 26 deletions(-) diff --git a/src/stdlib_io_filesystem.F90 b/src/stdlib_io_filesystem.F90 index 3cb8dba51..b38c4a876 100644 --- a/src/stdlib_io_filesystem.F90 +++ b/src/stdlib_io_filesystem.F90 @@ -31,7 +31,7 @@ logical function is_windows() end if is_windows = .false. - end + end function !> Version: experimental !> @@ -43,7 +43,7 @@ character function path_separator() else path_separator = '/' end if - end + end function !> Version: experimental !> @@ -58,7 +58,7 @@ logical function exists(path) #if defined(__INTEL_COMPILER) if (.not. exists) inquire(directory=path, exist=exists) #endif - end + end function !> Version: experimental !> @@ -116,7 +116,7 @@ subroutine list_dir(dir, files, iostat, iomsg) files = [files, string_type(line)] end do close(unit, status="delete") - end + end subroutine !> Version: experimental !> @@ -132,7 +132,7 @@ subroutine mkdir(dir, iostat, iomsg) else call run('mkdir -p '//dir, iostat, iomsg) end if - end + end subroutine !> Version: experimental !> @@ -146,7 +146,7 @@ subroutine rmdir(dir) else call run('rm -rf '//dir) end if - end + end subroutine !> Version: experimental !> @@ -177,5 +177,5 @@ subroutine run(command, iostat, iomsg) end if if (present(iomsg) .and. trim(adjustl(cmdmsg)) /= '') iomsg = cmdmsg end if - end -end + end subroutine +end module diff --git a/test/io/test_filesystem.f90 b/test/io/test_filesystem.f90 index 44b846525..a6a0cd359 100644 --- a/test/io/test_filesystem.f90 +++ b/test/io/test_filesystem.f90 @@ -32,7 +32,7 @@ subroutine collect_filesystem(testsuite) new_unittest("fs_rmdir_empty", fs_rmdir_empty), & new_unittest("fs_rmdir_with_contents", fs_rmdir_with_contents) & ] - end + end subroutine subroutine fs_is_windows(error) type(error_type), allocatable, intent(out) :: error @@ -46,7 +46,7 @@ subroutine fs_is_windows(error) else call check(error, stat /= 0 .and. length == 0, "Windows should not be detected.") end if - end + end subroutine subroutine fs_file_not_exists(error) type(error_type), allocatable, intent(out) :: error @@ -55,7 +55,7 @@ subroutine fs_file_not_exists(error) is_existing = exists("nonexistent") call check(error, is_existing, "Non-existent file should fail.") - end + end subroutine subroutine fs_file_exists(error) type(error_type), allocatable, intent(out) :: error @@ -70,7 +70,7 @@ subroutine fs_file_exists(error) is_existing = exists(filename) call check(error, is_existing, "An existing file should not fail.") call delete_file(filename) - end + end subroutine subroutine fs_current_dir_exists(error) type(error_type), allocatable, intent(out) :: error @@ -79,7 +79,7 @@ subroutine fs_current_dir_exists(error) is_existing = exists(".") call check(error, is_existing, "Current directory should not fail.") - end + end subroutine subroutine fs_path_separator(error) type(error_type), allocatable, intent(out) :: error @@ -94,7 +94,7 @@ subroutine fs_path_separator(error) call mkdir(outer_dir//path_separator()//inner_dir) call check(error, exists(outer_dir//path_separator()//inner_dir), "Inner directory should now exist.") call rmdir(outer_dir) - end + end subroutine subroutine fs_run_invalid_command(error) type(error_type), allocatable, intent(out) :: error @@ -103,7 +103,7 @@ subroutine fs_run_invalid_command(error) call run("invalid_command", iostat=stat) call check(error, stat, "Running an invalid command should fail.") - end + end subroutine subroutine fs_run_with_invalid_option(error) type(error_type), allocatable, intent(out) :: error @@ -112,7 +112,7 @@ subroutine fs_run_with_invalid_option(error) call run("whoami -X", iostat=stat) call check(error, stat, "Running a valid command with an invalid option should fail.") - end + end subroutine subroutine fs_run_valid_command(error) type(error_type), allocatable, intent(out) :: error @@ -121,7 +121,7 @@ subroutine fs_run_valid_command(error) call run("whoami", iostat=stat) call check(error, stat, "Running a valid command should not fail.") - end + end subroutine subroutine fs_list_dir_empty(error) type(error_type), allocatable, intent(out) :: error @@ -140,7 +140,7 @@ subroutine fs_list_dir_empty(error) call check(error, size(files) == 0, "The directory should be empty.") call rmdir(temp_list_dir) - end + end subroutine subroutine fs_list_dir_one_file(error) type(error_type), allocatable, intent(out) :: error @@ -167,7 +167,7 @@ subroutine fs_list_dir_one_file(error) call check(error, char(files(1)) == filename, "The file should be '"//filename//"'.") call rmdir(temp_list_dir) - end + end subroutine subroutine fs_list_dir_two_files(error) type(error_type), allocatable, intent(out) :: error @@ -201,7 +201,7 @@ subroutine fs_list_dir_two_files(error) call check(error, char(files(2)) == filename2, "The file should be '"//filename2//"'.") call rmdir(temp_list_dir) - end + end subroutine subroutine fs_list_dir_one_file_one_dir(error) type(error_type), allocatable, intent(out) :: error @@ -239,7 +239,7 @@ subroutine fs_list_dir_one_file_one_dir(error) call check(error, char(contents(2)) == dir, "The file should be '"//dir//"'.") call rmdir(temp_list_dir) - end + end subroutine subroutine fs_rmdir_empty(error) type(error_type), allocatable, intent(out) :: error @@ -252,7 +252,7 @@ subroutine fs_rmdir_empty(error) call check(error, exists(dir), "Directory should exist.") call rmdir(dir) call check(error, .not. exists(dir), "Directory should not exist.") - end + end subroutine subroutine fs_rmdir_with_contents(error) type(error_type), allocatable, intent(out) :: error @@ -270,7 +270,7 @@ subroutine fs_rmdir_with_contents(error) end if call rmdir(dir) call check(error, .not. exists(dir), "Directory should not exist.") - end + end subroutine subroutine delete_file(filename) character(len=*), intent(in) :: filename @@ -279,8 +279,8 @@ subroutine delete_file(filename) open(newunit=io, file=filename) close(io, status="delete") - end -end + end subroutine +end module program tester use, intrinsic :: iso_fortran_env, only : error_unit @@ -306,4 +306,4 @@ program tester write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!" error stop end if -end +end program From 84fca8bdce3113e5a93498259fbf4b15e6d1f4f9 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 10 Oct 2024 00:29:50 +0700 Subject: [PATCH 15/19] Obtain os from cmake and python script and make is_windows and path_separator parameters --- CMakeLists.txt | 1 + config/fypp_deployment.py | 2 + doc/specs/stdlib_io.md | 36 ------------- src/CMakeLists.txt | 2 +- ...lesystem.F90 => stdlib_io_filesystem.fypp} | 52 +++++-------------- test/io/test_filesystem.f90 | 10 ++-- 6 files changed, 22 insertions(+), 81 deletions(-) rename src/{stdlib_io_filesystem.F90 => stdlib_io_filesystem.fypp} (77%) diff --git a/CMakeLists.txt b/CMakeLists.txt index b10e1f73d..a5e9a4550 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -65,6 +65,7 @@ list( "-DPROJECT_VERSION_MAJOR=${PROJECT_VERSION_MAJOR}" "-DPROJECT_VERSION_MINOR=${PROJECT_VERSION_MINOR}" "-DPROJECT_VERSION_PATCH=${PROJECT_VERSION_PATCH}" + "-DOS=\\\"${CMAKE_SYSTEM_NAME}\\\"" "-I${PROJECT_SOURCE_DIR}/include" ) diff --git a/config/fypp_deployment.py b/config/fypp_deployment.py index 9f3549e4f..77923d004 100644 --- a/config/fypp_deployment.py +++ b/config/fypp_deployment.py @@ -1,4 +1,5 @@ import os +import platform import fypp import argparse from joblib import Parallel, delayed @@ -42,6 +43,7 @@ def pre_process_fypp(args): kwd.append("-DWITH_QP=True") if args.with_xdp: kwd.append("-DWITH_XDP=True") + kwd.append("-DOS=\"{}\"".format(platform.system())) optparser = fypp.get_option_parser() options, leftover = optparser.parse_args(args=kwd) diff --git a/doc/specs/stdlib_io.md b/doc/specs/stdlib_io.md index 9e992c627..19c5e3712 100644 --- a/doc/specs/stdlib_io.md +++ b/doc/specs/stdlib_io.md @@ -123,42 +123,6 @@ Provides a text file called `filename` that contains the rank-2 `array`. {!example/io/example_savetxt.f90!} ``` -## `is_windows` - -### Status - -Experimental - -### Description - -Returns a logical value indicating whether the current operating system is Windows. - -### Syntax - -`is_windows = ` [[stdlib_io_filesystem(module):is_windows(function)]] `()` - -### Return value - -A logical value indicating whether the current operating system is Windows. - -## `path_separator` - -### Status - -Experimental - -### Description - -Returns the path separator for the current operating system. - -### Syntax - -`separator = ` [[stdlib_io_filesystem(module):path_separator(function)]] `()` - -### Return value - -A character value containing the path separator for the current operating system. - ## `exists` ### Status diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index b96accf47..3141f9b33 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -17,6 +17,7 @@ set(fppFiles stdlib_hash_64bit_pengy.fypp stdlib_hash_64bit_spookyv2.fypp stdlib_io.fypp + stdlib_io_filesystem.fypp stdlib_io_npy.fypp stdlib_io_npy_load.fypp stdlib_io_npy_save.fypp @@ -109,7 +110,6 @@ set(SRC stdlib_hashmaps.f90 stdlib_hashmap_chaining.f90 stdlib_hashmap_open.f90 - stdlib_io_filesystem.F90 stdlib_logger.f90 stdlib_sorting_radix_sort.f90 stdlib_system.F90 diff --git a/src/stdlib_io_filesystem.F90 b/src/stdlib_io_filesystem.fypp similarity index 77% rename from src/stdlib_io_filesystem.F90 rename to src/stdlib_io_filesystem.fypp index b38c4a876..e0043ac59 100644 --- a/src/stdlib_io_filesystem.F90 +++ b/src/stdlib_io_filesystem.fypp @@ -1,6 +1,6 @@ ! SPDX-Identifier: MIT - !> Interaction with the filesystem. +!> Interaction with the filesystem. module stdlib_io_filesystem use stdlib_string_type, only: string_type implicit none @@ -8,43 +8,17 @@ module stdlib_io_filesystem public :: temp_dir, is_windows, exists, path_separator, list_dir, mkdir, rmdir, run +#: if OS == 'Windows' + logical, parameter :: is_windows = .true. + character, parameter :: path_separator = '\' +#: else + logical, parameter :: is_windows = .false. + character, parameter :: path_separator = '/' +#: endif + character(*), parameter :: temp_dir = 'temp' contains - - !> Version: experimental - !> - !> Whether the operating system is Windows. - !> [Specification](../page/specs/stdlib_io.html#is_windows) - logical function is_windows() - character(len=255) :: value - integer :: length, stat - - call get_environment_variable('OSTYPE', value, length, stat) - if (stat == 0 .and. length > 0 .and. (index(value, 'win') > 0 .or. index(value, 'msys') > 0)) then - is_windows = .true.; return - end if - - call get_environment_variable('OS', value, length, stat) - if (stat == 0 .and. length > 0 .and. index(value, 'Windows_NT') > 0) then - is_windows = .true.; return - end if - - is_windows = .false. - end function - - !> Version: experimental - !> - !> Returns the path separator for the current operating system. - !> [Specification](../page/specs/stdlib_io.html#path_separator) - character function path_separator() - if (is_windows()) then - path_separator = '\' - else - path_separator = '/' - end if - end function - !> Version: experimental !> !> Whether a file or directory exists at the given path. @@ -89,9 +63,9 @@ subroutine list_dir(dir, files, iostat, iomsg) end if end if - listed_contents = temp_dir//path_separator()//'listed_contents.txt' + listed_contents = temp_dir//path_separator//'listed_contents.txt' - if (is_windows()) then + if (is_windows) then call run('dir /b '//dir//' > '//listed_contents, stat) else call run('ls '//dir//' > '//listed_contents, stat) @@ -127,7 +101,7 @@ subroutine mkdir(dir, iostat, iomsg) integer, optional, intent(out) :: iostat character(len=:), allocatable, optional, intent(out) :: iomsg - if (is_windows()) then + if (is_windows) then call run('mkdir '//dir, iostat, iomsg) else call run('mkdir -p '//dir, iostat, iomsg) @@ -141,7 +115,7 @@ subroutine mkdir(dir, iostat, iomsg) subroutine rmdir(dir) character(len=*), intent(in) :: dir - if (is_windows()) then + if (is_windows) then call run('rmdir /s/q '//dir) else call run('rm -rf '//dir) diff --git a/test/io/test_filesystem.f90 b/test/io/test_filesystem.f90 index a6a0cd359..55068ddef 100644 --- a/test/io/test_filesystem.f90 +++ b/test/io/test_filesystem.f90 @@ -41,7 +41,7 @@ subroutine fs_is_windows(error) integer :: length, stat call get_environment_variable('HOMEDRIVE', value, length, stat) - if (is_windows()) then + if (is_windows) then call check(error, stat == 0 .and. length > 0, "Windows should be detected.") else call check(error, stat /= 0 .and. length == 0, "Windows should not be detected.") @@ -91,8 +91,8 @@ subroutine fs_path_separator(error) call check(error, .not. exists(outer_dir), "Directory should not exist.") call mkdir(outer_dir) call check(error, exists(outer_dir), "Outer directory should now exist.") - call mkdir(outer_dir//path_separator()//inner_dir) - call check(error, exists(outer_dir//path_separator()//inner_dir), "Inner directory should now exist.") + call mkdir(outer_dir//path_separator//inner_dir) + call check(error, exists(outer_dir//path_separator//inner_dir), "Inner directory should now exist.") call rmdir(outer_dir) end subroutine @@ -223,7 +223,7 @@ subroutine fs_list_dir_one_file_one_dir(error) call test_failed(error, "Creating file 1 in directory '"//temp_list_dir//"' failed."); return end if - if (is_windows()) then + if (is_windows) then call mkdir(temp_list_dir//'\'//dir, stat) else call mkdir(temp_list_dir//'/'//dir, stat) @@ -263,7 +263,7 @@ subroutine fs_rmdir_with_contents(error) call check(error, .not. exists(dir), "Directory should not exist.") call mkdir(dir) call check(error, exists(dir), "Directory should exist.") - if (is_windows()) then + if (is_windows) then call mkdir(dir//'\'//'another_dir') else call mkdir(dir//'/'//'another_dir') From e701d684bc68e2935ed161267d0984eeb04acf78 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 10 Oct 2024 12:13:18 +0700 Subject: [PATCH 16/19] Improve tests --- test/io/test_filesystem.f90 | 73 ++++++++++++++++++------------------- 1 file changed, 36 insertions(+), 37 deletions(-) diff --git a/test/io/test_filesystem.f90 b/test/io/test_filesystem.f90 index 55068ddef..c05cf2fb0 100644 --- a/test/io/test_filesystem.f90 +++ b/test/io/test_filesystem.f90 @@ -17,11 +17,12 @@ subroutine collect_filesystem(testsuite) type(unittest_type), allocatable, intent(out) :: testsuite(:) testsuite = [ & - new_unittest("fs_file_is_windows", fs_is_windows), & + new_unittest("fs_is_windows", fs_is_windows), & + new_unittest("fs_path_separator", fs_path_separator), & new_unittest("fs_file_not_exists", fs_file_not_exists, should_fail=.true.), & new_unittest("fs_file_exists", fs_file_exists), & new_unittest("fs_current_dir_exists", fs_current_dir_exists), & - new_unittest("fs_path_separator", fs_path_separator), & + new_unittest("fs_use_path_separator", fs_path_separator), & new_unittest("fs_run_invalid_command", fs_run_invalid_command, should_fail=.true.), & new_unittest("fs_run_with_invalid_option", fs_run_with_invalid_option, should_fail=.true.), & new_unittest("fs_run_valid_command", fs_run_valid_command), & @@ -48,6 +49,20 @@ subroutine fs_is_windows(error) end if end subroutine + subroutine fs_path_separator(error) + type(error_type), allocatable, intent(out) :: error + + character(len=255) :: value + integer :: length, stat + + call get_environment_variable('HOMEDRIVE', value, length, stat) + if (stat == 0 .and. length > 0) then + call check(error, path_separator == '\\', "Path separator should be set for Windows.") + else + call check(error, path_separator == '/', "Path separator should not be set for non-Windows.") + end if + end subroutine + subroutine fs_file_not_exists(error) type(error_type), allocatable, intent(out) :: error @@ -61,12 +76,9 @@ subroutine fs_file_exists(error) type(error_type), allocatable, intent(out) :: error logical :: is_existing - integer :: unit character(*), parameter :: filename = "file.tmp" - open(newunit=unit, file=filename) - close(unit) - + call create_file(filename) is_existing = exists(filename) call check(error, is_existing, "An existing file should not fail.") call delete_file(filename) @@ -81,7 +93,7 @@ subroutine fs_current_dir_exists(error) call check(error, is_existing, "Current directory should not fail.") end subroutine - subroutine fs_path_separator(error) + subroutine fs_use_path_separator(error) type(error_type), allocatable, intent(out) :: error character(*), parameter :: outer_dir = "path_separator_outer" @@ -156,10 +168,7 @@ subroutine fs_list_dir_one_file(error) call test_failed(error, "Creating directory '"//temp_list_dir//"' failed."); return end if - call run('touch '//temp_list_dir//'/'//filename, iostat=stat) - if (stat /= 0) then - call test_failed(error, "Creating file'"//filename//"' in directory '"//temp_list_dir//"' failed."); return - end if + call create_file(temp_list_dir//path_separator//filename) call list_dir(temp_list_dir, files, stat) call check(error, stat, "Listing the contents of an empty directory shouldn't fail.") @@ -184,15 +193,8 @@ subroutine fs_list_dir_two_files(error) call test_failed(error, "Creating directory '"//temp_list_dir//"' failed."); return end if - call run('touch '//temp_list_dir//'/'//filename1, iostat=stat) - if (stat /= 0) then - call test_failed(error, "Creating file 1 in directory '"//temp_list_dir//"' failed."); return - end if - - call run('touch '//temp_list_dir//'/'//filename2, iostat=stat) - if (stat /= 0) then - call test_failed(error, "Creating file 2 in directory '"//temp_list_dir//"' failed."); return - end if + call create_file(temp_list_dir//path_separator//filename1) + call create_file(temp_list_dir//path_separator//filename2) call list_dir(temp_list_dir, files, stat) call check(error, stat, "Listing the contents of an empty directory shouldn't fail.") @@ -209,7 +211,7 @@ subroutine fs_list_dir_one_file_one_dir(error) integer :: stat type(string_type), allocatable :: contents(:) - character(*), parameter :: filename1 = 'abc.txt' + character(*), parameter :: filename = 'abc.txt' character(*), parameter :: dir = 'xyz' call rmdir(temp_list_dir) @@ -218,16 +220,8 @@ subroutine fs_list_dir_one_file_one_dir(error) call test_failed(error, "Creating directory '"//temp_list_dir//"' failed."); return end if - call run('touch '//temp_list_dir//'/'//filename1, iostat=stat) - if (stat /= 0) then - call test_failed(error, "Creating file 1 in directory '"//temp_list_dir//"' failed."); return - end if - - if (is_windows) then - call mkdir(temp_list_dir//'\'//dir, stat) - else - call mkdir(temp_list_dir//'/'//dir, stat) - end if + call create_file(temp_list_dir//path_separator//filename) + call mkdir(temp_list_dir//path_separator//dir, stat) if (stat /= 0) then call test_failed(error, "Creating dir in directory '"//temp_list_dir//"' failed."); return end if @@ -235,7 +229,7 @@ subroutine fs_list_dir_one_file_one_dir(error) call list_dir(temp_list_dir, contents, stat) call check(error, stat, "Listing the contents of an empty directory shouldn't fail.") call check(error, size(contents) == 2, "The directory should contain two files.") - call check(error, char(contents(1)) == filename1, "The file should be '"//filename1//"'.") + call check(error, char(contents(1)) == filename, "The file should be '"//filename//"'.") call check(error, char(contents(2)) == dir, "The file should be '"//dir//"'.") call rmdir(temp_list_dir) @@ -263,15 +257,20 @@ subroutine fs_rmdir_with_contents(error) call check(error, .not. exists(dir), "Directory should not exist.") call mkdir(dir) call check(error, exists(dir), "Directory should exist.") - if (is_windows) then - call mkdir(dir//'\'//'another_dir') - else - call mkdir(dir//'/'//'another_dir') - end if + call mkdir(dir//path_separator//'another_dir') call rmdir(dir) call check(error, .not. exists(dir), "Directory should not exist.") end subroutine + subroutine create_file(filename) + character(len=*), intent(in) :: filename + + integer :: io + + open(newunit=io, file=filename) + close(io) + end subroutine + subroutine delete_file(filename) character(len=*), intent(in) :: filename From bf14f0a95f56321dc9e19c052f67ba9308069a19 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 10 Oct 2024 12:50:57 +0700 Subject: [PATCH 17/19] Extract stdlib_filesystem --- doc/specs/index.md | 1 + doc/specs/stdlib_filesystem.md | 131 ++++++++++++++++++ doc/specs/stdlib_io.md | 108 --------------- src/CMakeLists.txt | 2 +- ...filesystem.fypp => stdlib_filesystem.fypp} | 16 ++- test/CMakeLists.txt | 1 + test/filesystem/CMakeLists.txt | 1 + test/{io => filesystem}/test_filesystem.f90 | 2 +- test/io/CMakeLists.txt | 1 - 9 files changed, 146 insertions(+), 117 deletions(-) create mode 100644 doc/specs/stdlib_filesystem.md rename src/{stdlib_io_filesystem.fypp => stdlib_filesystem.fypp} (89%) create mode 100644 test/filesystem/CMakeLists.txt rename test/{io => filesystem}/test_filesystem.f90 (99%) diff --git a/doc/specs/index.md b/doc/specs/index.md index de3eb8f38..b965b006f 100644 --- a/doc/specs/index.md +++ b/doc/specs/index.md @@ -17,6 +17,7 @@ This is an index/directory of the specifications (specs) for each new module/fea - [constants](./stdlib_constants.html) - Constants - [bitsets](./stdlib_bitsets.html) - Bitset data types and procedures - [error](./stdlib_error.html) - Catching and handling errors + - [filesystem](./stdlib_filesystem.html) - Filesystem interactions - [hash](./stdlib_hash_procedures.html) - Hashing integer vectors or character strings - [hashmaps](./stdlib_hashmaps.html) - Hash maps/tables diff --git a/doc/specs/stdlib_filesystem.md b/doc/specs/stdlib_filesystem.md new file mode 100644 index 000000000..90b48eeed --- /dev/null +++ b/doc/specs/stdlib_filesystem.md @@ -0,0 +1,131 @@ +--- +title: filesystem +--- + +# The `stdlib_filesystem` module + +[TOC] + +## Introduction + +Module for filesystem interactions. + +## Constants + +### `is_windows`` + +Boolean constant indicating whether the current platform is Windows. + +### `path_separator`` + +Character constant representing the path separator for the current platform. On Windows, it is `\`. On other platforms, it is `/`. + +## Procedures + +### `exists` + +#### Status + +Experimental + +#### Description + +Determines if a file or directory exists at the given path by returning a logical value. + +#### Syntax + +`exists = ` [[stdlib_filesystem(module):exists(function)]] `(path)` + +#### Arguments + +`path`: Shall be a character expression containing the path to a file or directory to check for existence. + +#### Return value + +A logical value indicating whether a file or directory exists at the given path. + +### `list_dir` + +#### Status + +Experimental + +#### Description + +Lists the contents of a directory. + +#### Syntax + +`call ` [[stdlib_filesystem(module):list_dir(subroutine)]] `(dir, files[, iostat][, iomsg])` + +#### Arguments + +`dir`: Shall be a character expression containing the path to the directory to list. + +`files`: Shall be an allocatable rank-1 array of type `string_type` that will contain the names of the files and directories in the directory. + +`iostat`: Shall be a scalar of type `integer` that receives the error status of `list_dir`. Optional argument. + +`iomsg`: Shall be a deferred length character variable that receives the error message of `list_dir`. Optional argument. + +### `mkdir` + +#### Status + +Experimental + +#### Description + +Creates a new directory. + +#### Syntax + +`call ` [[stdlib_filesystem(module):mkdir(subroutine)]] `(dir[, iostat][, iomsg])` + +#### Arguments + +`dir`: Shall be a character expression containing the path to the directory to create. + +`iostat`: Shall be a scalar of type `integer` that receives the error status of `mkdir`. Optional argument. + +`iomsg`: Shall be a deferred length character variable that receives the error message of `mkdir`. Optional argument. + +### `rmdir` + +#### Status + +Experimental + +#### Description + +Removes a directory. + +#### Syntax + +`call ` [[stdlib_filesystem(module):rmdir(subroutine)]] `(dir)` + +#### Arguments + +`dir`: Shall be a character expression containing the path to the directory to remove. + +### `run` + +#### Status + +Experimental + +#### Description + +Runs a command in the shell. + +#### Syntax + +`call ` [[stdlib_filesystem(module):run(subroutine)]] `(command[, iostat][, iomsg])` + +#### Arguments + +`command`: Shall be a character expression containing the command to run in the shell. + +`iostat`: Shall be a scalar of type `integer` that receives the error status of `run`. Optional argument. + +`iomsg`: Shall be a deferred length character variable that receives the error message of `run`. Optional argument. diff --git a/doc/specs/stdlib_io.md b/doc/specs/stdlib_io.md index 19c5e3712..aaf90715d 100644 --- a/doc/specs/stdlib_io.md +++ b/doc/specs/stdlib_io.md @@ -123,114 +123,6 @@ Provides a text file called `filename` that contains the rank-2 `array`. {!example/io/example_savetxt.f90!} ``` -## `exists` - -### Status - -Experimental - -### Description - -Determines if a file or directory exists at the given path by returning a logical value. - -### Syntax - -`exists = ` [[stdlib_io_filesystem(module):exists(function)]] `(path)` - -### Arguments - -`path`: Shall be a character expression containing the path to a file or directory to check for existence. - -### Return value - -A logical value indicating whether a file or directory exists at the given path. - -## `list_dir` - -### Status - -Experimental - -### Description - -Lists the contents of a directory. - -### Syntax - -`call ` [[stdlib_io_filesystem(module):list_dir(subroutine)]] `(dir, files[, iostat][, iomsg])` - -### Arguments - -`dir`: Shall be a character expression containing the path to the directory to list. - -`files`: Shall be an allocatable rank-1 array of type `string_type` that will contain the names of the files and directories in the directory. - -`iostat`: Shall be a scalar of type `integer` that receives the error status of `list_dir`. Optional argument. - -`iomsg`: Shall be a deferred length character variable that receives the error message of `list_dir`. Optional argument. - -## `mkdir` - -### Status - -Experimental - -### Description - -Creates a new directory. - -### Syntax - -`call ` [[stdlib_io_filesystem(module):mkdir(subroutine)]] `(dir[, iostat][, iomsg])` - -### Arguments - -`dir`: Shall be a character expression containing the path to the directory to create. - -`iostat`: Shall be a scalar of type `integer` that receives the error status of `mkdir`. Optional argument. - -`iomsg`: Shall be a deferred length character variable that receives the error message of `mkdir`. Optional argument. - -## `rmdir` - -### Status - -Experimental - -### Description - -Removes a directory. - -### Syntax - -`call ` [[stdlib_io_filesystem(module):rmdir(subroutine)]] `(dir)` - -### Arguments - -`dir`: Shall be a character expression containing the path to the directory to remove. - -## `run` - -### Status - -Experimental - -### Description - -Runs a command in the shell. - -### Syntax - -`call ` [[stdlib_io_filesystem(module):run(subroutine)]] `(command[, iostat][, iomsg])` - -### Arguments - -`command`: Shall be a character expression containing the command to run in the shell. - -`iostat`: Shall be a scalar of type `integer` that receives the error status of `run`. Optional argument. - -`iomsg`: Shall be a deferred length character variable that receives the error message of `run`. Optional argument. - ## `load_npy` ### Status diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 3141f9b33..9e1723c92 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -8,6 +8,7 @@ set(fppFiles stdlib_bitsets_large.fypp stdlib_codata_type.fypp stdlib_constants.fypp + stdlib_filesystem.fypp stdlib_hash_32bit.fypp stdlib_hash_32bit_fnv.fypp stdlib_hash_32bit_nm.fypp @@ -17,7 +18,6 @@ set(fppFiles stdlib_hash_64bit_pengy.fypp stdlib_hash_64bit_spookyv2.fypp stdlib_io.fypp - stdlib_io_filesystem.fypp stdlib_io_npy.fypp stdlib_io_npy_load.fypp stdlib_io_npy_save.fypp diff --git a/src/stdlib_io_filesystem.fypp b/src/stdlib_filesystem.fypp similarity index 89% rename from src/stdlib_io_filesystem.fypp rename to src/stdlib_filesystem.fypp index e0043ac59..9d022baa0 100644 --- a/src/stdlib_io_filesystem.fypp +++ b/src/stdlib_filesystem.fypp @@ -1,7 +1,7 @@ ! SPDX-Identifier: MIT !> Interaction with the filesystem. -module stdlib_io_filesystem +module stdlib_filesystem use stdlib_string_type, only: string_type implicit none private @@ -9,10 +9,14 @@ module stdlib_io_filesystem public :: temp_dir, is_windows, exists, path_separator, list_dir, mkdir, rmdir, run #: if OS == 'Windows' + !> Whether the operating system is Windows. logical, parameter :: is_windows = .true. + !> Path separator for Windows. character, parameter :: path_separator = '\' #: else + !> Whether the operating system is Windows. logical, parameter :: is_windows = .false. + !> Path separator for filesystems on non-Windows operating systems. character, parameter :: path_separator = '/' #: endif @@ -22,7 +26,7 @@ contains !> Version: experimental !> !> Whether a file or directory exists at the given path. - !> [Specification](../page/specs/stdlib_io.html#exists) + !> [Specification](../page/specs/stdlib_filesystem.html#exists) logical function exists(path) !> Path to a file or directory. character(len=*), intent(in) :: path @@ -37,7 +41,7 @@ contains !> Version: experimental !> !> List files and directories of a directory. Does not list hidden files. - !> [Specification](../page/specs/stdlib_io.html#list_dir) + !> [Specification](../page/specs/stdlib_filesystem.html#list_dir) subroutine list_dir(dir, files, iostat, iomsg) !> Directory to list. character(len=*), intent(in) :: dir @@ -95,7 +99,7 @@ contains !> Version: experimental !> !> Create a directory. - !> [Specification](../page/specs/stdlib_io.html#mkdir) + !> [Specification](../page/specs/stdlib_filesystem.html#mkdir) subroutine mkdir(dir, iostat, iomsg) character(len=*), intent(in) :: dir integer, optional, intent(out) :: iostat @@ -111,7 +115,7 @@ contains !> Version: experimental !> !> Remove a directory including its contents. - !> [Specification](../page/specs/stdlib_io.html#rmdir) + !> [Specification](../page/specs/stdlib_filesystem.html#rmdir) subroutine rmdir(dir) character(len=*), intent(in) :: dir @@ -125,7 +129,7 @@ contains !> Version: experimental !> !> Run a command in the shell. - !> [Specification](../page/specs/stdlib_io.html#run) + !> [Specification](../page/specs/stdlib_filesystem.html#run) subroutine run(command, iostat, iomsg) !> Command to run. character(len=*), intent(in) :: command diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index 4d83548db..737938a64 100644 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -14,6 +14,7 @@ add_subdirectory(array) add_subdirectory(ascii) add_subdirectory(bitsets) add_subdirectory(constants) +add_subdirectory(filesystem) add_subdirectory(hash_functions) add_subdirectory(hash_functions_perf) add_subdirectory(hashmaps) diff --git a/test/filesystem/CMakeLists.txt b/test/filesystem/CMakeLists.txt new file mode 100644 index 000000000..48d7eb893 --- /dev/null +++ b/test/filesystem/CMakeLists.txt @@ -0,0 +1 @@ +ADDTEST(filesystem) diff --git a/test/io/test_filesystem.f90 b/test/filesystem/test_filesystem.f90 similarity index 99% rename from test/io/test_filesystem.f90 rename to test/filesystem/test_filesystem.f90 index c05cf2fb0..373da053c 100644 --- a/test/io/test_filesystem.f90 +++ b/test/filesystem/test_filesystem.f90 @@ -1,5 +1,5 @@ module test_filesystem - use stdlib_io_filesystem + use stdlib_filesystem use stdlib_string_type, only: char, string_type use testdrive, only: new_unittest, unittest_type, error_type, check, test_failed implicit none diff --git a/test/io/CMakeLists.txt b/test/io/CMakeLists.txt index 77a12c323..98794cd88 100644 --- a/test/io/CMakeLists.txt +++ b/test/io/CMakeLists.txt @@ -13,7 +13,6 @@ ADDTEST(savetxt_qp) set_tests_properties(loadtxt_qp PROPERTIES LABELS quadruple_precision) set_tests_properties(savetxt_qp PROPERTIES LABELS quadruple_precision) -ADDTEST(filesystem) ADDTEST(getline) ADDTEST(npy) ADDTEST(open) From ff9242aeb59eb5238b89de32ba0bbe44456350bd Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 10 Oct 2024 12:52:16 +0700 Subject: [PATCH 18/19] Revert changes in stdlib_io.md --- doc/specs/stdlib_io.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/doc/specs/stdlib_io.md b/doc/specs/stdlib_io.md index aaf90715d..8c868802a 100644 --- a/doc/specs/stdlib_io.md +++ b/doc/specs/stdlib_io.md @@ -123,6 +123,7 @@ Provides a text file called `filename` that contains the rank-2 `array`. {!example/io/example_savetxt.f90!} ``` + ## `load_npy` ### Status @@ -163,6 +164,7 @@ Returns an allocated `array` with the content of `filename` in case of success. {!example/io/example_loadnpy.f90!} ``` + ## `save_npy` ### Status From b0ce5654ecf23d48f9f513ac610bd1adc801505f Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 10 Oct 2024 15:33:58 +0700 Subject: [PATCH 19/19] Fix typo --- test/filesystem/test_filesystem.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/test/filesystem/test_filesystem.f90 b/test/filesystem/test_filesystem.f90 index 373da053c..44588519b 100644 --- a/test/filesystem/test_filesystem.f90 +++ b/test/filesystem/test_filesystem.f90 @@ -22,7 +22,7 @@ subroutine collect_filesystem(testsuite) new_unittest("fs_file_not_exists", fs_file_not_exists, should_fail=.true.), & new_unittest("fs_file_exists", fs_file_exists), & new_unittest("fs_current_dir_exists", fs_current_dir_exists), & - new_unittest("fs_use_path_separator", fs_path_separator), & + new_unittest("fs_use_path_separator", fs_use_path_separator), & new_unittest("fs_run_invalid_command", fs_run_invalid_command, should_fail=.true.), & new_unittest("fs_run_with_invalid_option", fs_run_with_invalid_option, should_fail=.true.), & new_unittest("fs_run_valid_command", fs_run_valid_command), & @@ -57,7 +57,7 @@ subroutine fs_path_separator(error) call get_environment_variable('HOMEDRIVE', value, length, stat) if (stat == 0 .and. length > 0) then - call check(error, path_separator == '\\', "Path separator should be set for Windows.") + call check(error, path_separator == '\', "Path separator should be set for Windows.") else call check(error, path_separator == '/', "Path separator should not be set for non-Windows.") end if