Skip to content

Commit d760b5f

Browse files
minhqdaominhqdao
committed
Extract filesystem interaction from big PR
1 parent 25fe661 commit d760b5f

File tree

4 files changed

+344
-0
lines changed

4 files changed

+344
-0
lines changed

‎src/CMakeLists.txt

Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -109,6 +109,7 @@ set(SRC
109109
stdlib_hashmaps.f90
110110
stdlib_hashmap_chaining.f90
111111
stdlib_hashmap_open.f90
112+
stdlib_io_filesystem.f90
112113
stdlib_logger.f90
113114
stdlib_sorting_radix_sort.f90
114115
stdlib_system.F90
@@ -120,6 +121,17 @@ set(SRC
120121
${outPreprocFiles}
121122
)
122123

124+
# Files that have cpp directives and need to be preprocessed.
125+
set(hasCPP
126+
stdlib_io_filesystem.f90
127+
)
128+
129+
if(CMAKE_Fortran_COMPILER_ID STREQUAL "GNU")
130+
set_source_files_properties(${hasCPP} PROPERTIES COMPILE_FLAGS "-cpp")
131+
elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "Intel")
132+
set_source_files_properties(${hasCPP} PROPERTIES COMPILE_FLAGS "-fpp")
133+
endif()
134+
123135
add_library(${PROJECT_NAME} ${SRC})
124136

125137
set_target_properties(

‎src/stdlib_io_filesystem.f90

Lines changed: 112 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,112 @@
1+
! SPDX-Identifier: MIT
2+
3+
!> Interaction with the filesystem.
4+
module stdlib_io_filesystem
5+
use stdlib_string_type, only: string_type
6+
implicit none
7+
private
8+
9+
public :: exists, list_dir, run, temp_dir
10+
11+
character(*), parameter :: temp_dir = 'temp'
12+
character(*), parameter :: listed_contents = temp_dir//'/listed_contents.txt'
13+
14+
contains
15+
16+
!> Version: experimental
17+
!>
18+
!> Whether a file or directory exists at the given path.
19+
!> [Specification](../page/specs/stdlib_io.html#exists)
20+
logical function exists(filename)
21+
!> Name of the file or directory.
22+
character(len=*), intent(in) :: filename
23+
24+
inquire(file=filename, exist=exists)
25+
26+
#if defined(__INTEL_COMPILER)
27+
if (.not. exists) inquire(directory=filename, exist=exists)
28+
#endif
29+
end
30+
31+
!> Version: experimental
32+
!>
33+
!> List files and directories of a directory. Does not list hidden files.
34+
!> [Specification](../page/specs/stdlib_io.html#list_dir)
35+
subroutine list_dir(dir, files, iostat, iomsg)
36+
!> Directory to list.
37+
character(len=*), intent(in) :: dir
38+
!> List of files and directories.
39+
type(string_type), allocatable, intent(out) :: files(:)
40+
!> Status of listing.
41+
integer, optional, intent(out) :: iostat
42+
!> Error message.
43+
character(len=:), allocatable, optional, intent(out) :: iomsg
44+
45+
integer :: unit, stat
46+
character(len=256) :: line
47+
48+
stat = 0
49+
50+
if (.not. exists(temp_dir)) then
51+
call run('mkdir '//temp_dir, stat)
52+
if (stat /= 0) then
53+
if (present(iostat)) iostat = stat
54+
if (present(iomsg)) iomsg = "Failed to create temporary directory '"//temp_dir//"'."
55+
return
56+
end if
57+
end if
58+
59+
call run('ls '//dir//' > '//listed_contents, stat)
60+
if (stat /= 0) then
61+
if (present(iostat)) iostat = stat
62+
if (present(iomsg)) iomsg = "Failed to list files in directory '"//dir//"'."
63+
return
64+
end if
65+
66+
open(newunit=unit, file=listed_contents, status='old', action='read', iostat=stat)
67+
if (stat /= 0) then
68+
if (present(iostat)) iostat = stat
69+
if (present(iomsg)) iomsg = "Failed to open file '"//listed_contents//"'."
70+
return
71+
end if
72+
73+
allocate(files(0))
74+
do
75+
read(unit, '(A)', iostat=stat) line
76+
if (stat /= 0) exit
77+
files = [files, string_type(line)]
78+
end do
79+
close(unit, status="delete")
80+
end
81+
82+
!> Version: experimental
83+
!>
84+
!> Run a command in the shell.
85+
!> [Specification](../page/specs/stdlib_io.html#run)
86+
subroutine run(command, iostat, iomsg)
87+
!> Command to run.
88+
character(len=*), intent(in) :: command
89+
!> Status of the operation.
90+
integer, intent(out), optional :: iostat
91+
!> Error message.
92+
character(len=:), allocatable, intent(out), optional :: iomsg
93+
94+
integer :: exitstat, cmdstat
95+
character(len=256) :: cmdmsg
96+
97+
if (present(iostat)) iostat = 0
98+
exitstat = 0; cmdstat = 0
99+
100+
call execute_command_line(command, exitstat=exitstat, cmdstat=cmdstat, cmdmsg=cmdmsg)
101+
if (exitstat /= 0 .or. cmdstat /= 0) then
102+
if (present(iostat)) then
103+
if (exitstat /= 0) then
104+
iostat = exitstat
105+
else
106+
iostat = cmdstat
107+
end if
108+
end if
109+
if (present(iomsg) .and. trim(adjustl(cmdmsg)) /= '') iomsg = cmdmsg
110+
end if
111+
end
112+
end

‎test/io/CMakeLists.txt

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -13,6 +13,7 @@ ADDTEST(savetxt_qp)
1313
set_tests_properties(loadtxt_qp PROPERTIES LABELS quadruple_precision)
1414
set_tests_properties(savetxt_qp PROPERTIES LABELS quadruple_precision)
1515

16+
ADDTEST(filesystem)
1617
ADDTEST(getline)
1718
ADDTEST(npy)
1819
ADDTEST(open)

‎test/io/test_filesystem.f90

Lines changed: 219 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,219 @@
1+
module test_filesystem
2+
use stdlib_io_filesystem
3+
use stdlib_string_type, only: char, string_type
4+
use testdrive, only: new_unittest, unittest_type, error_type, check, test_failed
5+
implicit none
6+
private
7+
8+
public :: collect_filesystem
9+
10+
character(*), parameter :: temp_list_dir = 'temp_list_dir'
11+
12+
contains
13+
14+
!> Collect all exported unit tests
15+
subroutine collect_filesystem(testsuite)
16+
!> Collection of tests
17+
type(unittest_type), allocatable, intent(out) :: testsuite(:)
18+
19+
testsuite = [ &
20+
new_unittest("fs_file_not_exists", fs_file_not_exists, should_fail=.true.), &
21+
new_unittest("fs_file_exists", fs_file_exists), &
22+
new_unittest("fs_current_dir_exists", fs_current_dir_exists), &
23+
new_unittest("fs_run_invalid_command", fs_run_invalid_command, should_fail=.true.), &
24+
new_unittest("fs_run_with_invalid_option", fs_run_with_invalid_option, should_fail=.true.), &
25+
new_unittest("fs_run_valid_command", fs_run_valid_command), &
26+
new_unittest("fs_list_dir_empty", fs_list_dir_empty), &
27+
new_unittest("fs_list_dir_one_file", fs_list_dir_one_file), &
28+
new_unittest("fs_list_dir_two_files", fs_list_dir_two_files) &
29+
]
30+
end
31+
32+
subroutine fs_file_not_exists(error)
33+
type(error_type), allocatable, intent(out) :: error
34+
35+
logical :: is_existing
36+
37+
is_existing = exists("nonexistent")
38+
call check(error, is_existing, "Non-existent file should fail.")
39+
end
40+
41+
subroutine fs_file_exists(error)
42+
type(error_type), allocatable, intent(out) :: error
43+
44+
logical :: is_existing
45+
integer :: unit
46+
character(*), parameter :: filename = "file.tmp"
47+
48+
open(newunit=unit, file=filename)
49+
close(unit)
50+
51+
is_existing = exists(filename)
52+
call check(error, is_existing, "An existing file should not fail.")
53+
call delete_file(filename)
54+
end
55+
56+
subroutine fs_current_dir_exists(error)
57+
type(error_type), allocatable, intent(out) :: error
58+
59+
logical :: is_existing
60+
61+
is_existing = exists(".")
62+
call check(error, is_existing, "Current directory should not fail.")
63+
end
64+
65+
subroutine fs_run_invalid_command(error)
66+
type(error_type), allocatable, intent(out) :: error
67+
68+
integer :: stat
69+
70+
call run("invalid_command", iostat=stat)
71+
call check(error, stat, "Running an invalid command should fail.")
72+
end
73+
74+
subroutine fs_run_with_invalid_option(error)
75+
type(error_type), allocatable, intent(out) :: error
76+
77+
integer :: stat
78+
79+
call run("whoami -X", iostat=stat)
80+
call check(error, stat, "Running a valid command with an invalid option should fail.")
81+
end
82+
83+
subroutine fs_run_valid_command(error)
84+
type(error_type), allocatable, intent(out) :: error
85+
86+
integer :: stat
87+
88+
call run("whoami", iostat=stat)
89+
call check(error, stat, "Running a valid command should not fail.")
90+
end
91+
92+
subroutine fs_list_dir_empty(error)
93+
type(error_type), allocatable, intent(out) :: error
94+
95+
integer :: stat
96+
type(string_type), allocatable :: files(:)
97+
98+
call run('rm -rf '//temp_list_dir, iostat=stat)
99+
if (stat /= 0) then
100+
call test_failed(error, "Removing directory '"//temp_list_dir//"' failed."); return
101+
end if
102+
103+
call run('mkdir '//temp_list_dir, iostat=stat)
104+
if (stat /= 0) then
105+
call test_failed(error, "Creating directory '"//temp_list_dir//"' failed."); return
106+
end if
107+
108+
call list_dir(temp_list_dir, files, stat)
109+
call check(error, stat, "Listing the contents of an empty directory shouldn't fail.")
110+
call check(error, size(files) == 0, "The directory should be empty.")
111+
112+
call run('rm -rf '//temp_list_dir, iostat=stat)
113+
end
114+
115+
subroutine fs_list_dir_one_file(error)
116+
type(error_type), allocatable, intent(out) :: error
117+
118+
integer :: stat
119+
120+
type(string_type), allocatable :: files(:)
121+
character(*), parameter :: filename = 'abc.txt'
122+
123+
call run('rm -rf '//temp_list_dir, iostat=stat)
124+
if (stat /= 0) then
125+
call test_failed(error, "Removing directory '"//temp_list_dir//"' failed."); return
126+
end if
127+
128+
call run('mkdir '//temp_list_dir, iostat=stat)
129+
if (stat /= 0) then
130+
call test_failed(error, "Creating directory '"//temp_list_dir//"' failed."); return
131+
end if
132+
133+
call run('touch '//temp_list_dir//'/'//filename, iostat=stat)
134+
if (stat /= 0) then
135+
call test_failed(error, "Creating file'"//filename//"' in directory '"//temp_list_dir//"' failed."); return
136+
end if
137+
138+
call list_dir(temp_list_dir, files, stat)
139+
call check(error, stat, "Listing the contents of an empty directory shouldn't fail.")
140+
call check(error, size(files) == 1, "The directory should contain one file.")
141+
call check(error, char(files(1)) == filename, "The file should be '"//filename//"'.")
142+
143+
call run('rm -rf '//temp_list_dir, iostat=stat)
144+
end
145+
146+
subroutine fs_list_dir_two_files(error)
147+
type(error_type), allocatable, intent(out) :: error
148+
149+
integer :: stat
150+
151+
type(string_type), allocatable :: files(:)
152+
character(*), parameter :: filename1 = 'abc.txt'
153+
character(*), parameter :: filename2 = 'xyz'
154+
155+
call run('rm -rf '//temp_list_dir, iostat=stat)
156+
if (stat /= 0) then
157+
call test_failed(error, "Removing directory '"//temp_list_dir//"' failed."); return
158+
end if
159+
160+
call run('mkdir '//temp_list_dir, iostat=stat)
161+
if (stat /= 0) then
162+
call test_failed(error, "Creating directory '"//temp_list_dir//"' failed."); return
163+
end if
164+
165+
call run('touch '//temp_list_dir//'/'//filename1, iostat=stat)
166+
if (stat /= 0) then
167+
call test_failed(error, "Creating file 1 in directory '"//temp_list_dir//"' failed."); return
168+
end if
169+
170+
call run('touch '//temp_list_dir//'/'//filename2, iostat=stat)
171+
if (stat /= 0) then
172+
call test_failed(error, "Creating file 2 in directory '"//temp_list_dir//"' failed."); return
173+
end if
174+
175+
call list_dir(temp_list_dir, files, stat)
176+
call check(error, stat, "Listing the contents of an empty directory shouldn't fail.")
177+
call check(error, size(files) == 2, "The directory should contain two files.")
178+
call check(error, char(files(1)) == filename1, "The file should be '"//filename1//"'.")
179+
call check(error, char(files(2)) == filename2, "The file should be '"//filename2//"'.")
180+
181+
call run('rm -rf '//temp_list_dir, iostat=stat)
182+
end
183+
184+
subroutine delete_file(filename)
185+
character(len=*), intent(in) :: filename
186+
187+
integer :: io
188+
189+
open(newunit=io, file=filename)
190+
close(io, status="delete")
191+
end
192+
193+
end
194+
195+
program tester
196+
use, intrinsic :: iso_fortran_env, only : error_unit
197+
use testdrive, only : run_testsuite, new_testsuite, testsuite_type
198+
use test_filesystem, only : collect_filesystem
199+
implicit none
200+
integer :: stat, is
201+
type(testsuite_type), allocatable :: testsuites(:)
202+
character(len=*), parameter :: fmt = '("#", *(1x, a))'
203+
204+
stat = 0
205+
206+
testsuites = [ &
207+
new_testsuite("filesystem", collect_filesystem) &
208+
]
209+
210+
do is = 1, size(testsuites)
211+
write(error_unit, fmt) "Testing:", testsuites(is)%name
212+
call run_testsuite(testsuites(is)%collect, error_unit, stat)
213+
end do
214+
215+
if (stat > 0) then
216+
write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!"
217+
error stop
218+
end if
219+
end

0 commit comments

Comments
 (0)