@@ -2,7 +2,7 @@ module test_filesystem
2
2
use testdrive, only : new_unittest, unittest_type, error_type, check, skip_test
3
3
use stdlib_system, only: is_directory, delete_file, FS_ERROR, FS_ERROR_CODE, &
4
4
make_directory, remove_directory, make_directory_all, is_windows, OS_TYPE, &
5
- OS_WINDOWS
5
+ OS_WINDOWS, exists, type_unknown, type_regular_file, type_directory, type_symlink
6
6
use stdlib_error, only: state_type, STDLIB_FS_ERROR
7
7
8
8
implicit none
@@ -16,6 +16,10 @@ subroutine collect_suite(testsuite)
16
16
17
17
testsuite = [ &
18
18
new_unittest(" fs_error" , test_fs_error), &
19
+ new_unittest(" fs_exists_not_exists" , test_exists_not_exists), &
20
+ new_unittest(" fs_exists_reg_file" , test_exists_reg_file), &
21
+ new_unittest(" fs_exists_dir" , test_exists_dir), &
22
+ new_unittest(" fs_exists_symlink" , test_exists_symlink), &
19
23
new_unittest(" fs_is_directory_dir" , test_is_directory_dir), &
20
24
new_unittest(" fs_is_directory_file" , test_is_directory_file), &
21
25
new_unittest(" fs_delete_non_existent" , test_delete_file_non_existent), &
@@ -49,6 +53,162 @@ subroutine test_fs_error(error)
49
53
if (allocated (error)) return
50
54
end subroutine test_fs_error
51
55
56
+ subroutine test_exists_not_exists (error )
57
+ type (error_type), allocatable , intent (out ) :: error
58
+ type (state_type) :: err
59
+
60
+ character (* ), parameter :: path = " rand_name"
61
+ integer :: t
62
+
63
+ t = exists(path, err)
64
+ call check(error, err% error(), " False positive for a non-existent path!" )
65
+ end subroutine test_exists_not_exists
66
+
67
+ subroutine test_exists_reg_file (error )
68
+ type (error_type), allocatable , intent (out ) :: error
69
+ type (state_type) :: err
70
+ character (len= 256 ) :: filename
71
+ integer :: ios, iunit, t
72
+ character (len= 512 ) :: msg
73
+
74
+ filename = " test_file.txt"
75
+
76
+ ! Create a file
77
+ open (newunit= iunit, file= filename, status= " replace" , iostat= ios, iomsg= msg)
78
+ call check(error, ios == 0 , " Cannot init test_exists_reg_file: " // trim (msg))
79
+ if (allocated (error)) return
80
+
81
+ t = exists(filename, err)
82
+ call check(error, err% ok(), " exists failed for reg file: " // err% print ())
83
+
84
+ if (allocated (error)) then
85
+ ! Clean up: remove the file
86
+ close (iunit,status= ' delete' ,iostat= ios,iomsg= msg)
87
+ call check(error, ios == 0 , err% message// " and cannot delete test file: " // trim (msg))
88
+ return
89
+ end if
90
+
91
+ call check(error, t == type_regular_file, " exists incorrectly identifies type of reg files!" )
92
+
93
+ if (allocated (error)) then
94
+ ! Clean up: remove the file
95
+ close (iunit,status= ' delete' ,iostat= ios,iomsg= msg)
96
+ call check(error, ios == 0 , err% message// " and cannot delete test file: " // trim (msg))
97
+ return
98
+ end if
99
+
100
+ ! Clean up: remove the file
101
+ close (iunit,status= ' delete' ,iostat= ios,iomsg= msg)
102
+ call check(error, ios == 0 , " Cannot delete test file: " // trim (msg))
103
+ if (allocated (error)) return
104
+ end subroutine test_exists_reg_file
105
+
106
+ subroutine test_exists_dir (error )
107
+ type (error_type), allocatable , intent (out ) :: error
108
+ type (state_type) :: err
109
+ character (len= 256 ) :: dirname
110
+ integer :: ios, iocmd, t
111
+ character (len= 512 ) :: msg
112
+
113
+ dirname = " temp_dir"
114
+
115
+ ! Create a directory
116
+ call execute_command_line(" mkdir " // dirname, exitstat= ios, cmdstat= iocmd, cmdmsg= msg)
117
+ call check(error, ios == 0 .and. iocmd == 0 , " Cannot int test_exists_dir: " // trim (msg))
118
+ if (allocated (error)) return
119
+
120
+ t = exists(dirname, err)
121
+ call check(error, err% ok(), " exists failed for directory: " // err% print ())
122
+
123
+ if (allocated (error)) then
124
+ ! Clean up: remove the directory
125
+ call execute_command_line(" rmdir " // dirname, exitstat= ios, cmdstat= iocmd, cmdmsg= msg)
126
+ call check(error, ios == 0 .and. iocmd == 0 , err% message // " and &
127
+ & cannot cleanup test_exists_dir: " // trim (msg))
128
+ return
129
+ end if
130
+
131
+ call check(error, t == type_directory, " exists incorrectly identifies type of directories!" )
132
+
133
+ if (allocated (error)) then
134
+ ! Clean up: remove the directory
135
+ call execute_command_line(" rmdir " // dirname, exitstat= ios, cmdstat= iocmd, cmdmsg= msg)
136
+ call check(error, ios == 0 .and. iocmd == 0 , err% message // " and &
137
+ & cannot cleanup test_exists_dir: " // trim (msg))
138
+ return
139
+ end if
140
+
141
+ ! Clean up: remove the directory
142
+ call execute_command_line(" rmdir " // dirname, exitstat= ios, cmdstat= iocmd, cmdmsg= msg)
143
+ call check(error, ios == 0 .and. iocmd == 0 , " Cannot cleanup test_exists_dir: " // trim (msg))
144
+ end subroutine test_exists_dir
145
+
146
+ subroutine test_exists_symlink (error )
147
+ type (error_type), allocatable , intent (out ) :: error
148
+ type (state_type) :: err
149
+ character (len= 256 ) :: target_name, link_name, cmd
150
+ integer :: ios, iunit, iocmd, t
151
+ character (len= 512 ) :: msg
152
+
153
+ target_name = " test_file.txt"
154
+ link_name = " symlink.txt"
155
+
156
+ ! Create a file
157
+ open (newunit= iunit, file= target_name, status= " replace" , iostat= ios, iomsg= msg)
158
+ call check(error, ios == 0 , " Cannot init test_exists_symlink: " // trim (msg))
159
+ if (allocated (error)) return
160
+
161
+ if (is_windows()) then
162
+ cmd = ' mklink ' // link_name// ' ' // target_name
163
+ call execute_command_line(cmd, exitstat= ios, cmdstat= iocmd, cmdmsg= msg)
164
+ else
165
+ cmd = ' ln -s ' // link_name// ' ' // target_name
166
+ call execute_command_line(cmd, exitstat= ios, cmdstat= iocmd, cmdmsg= msg)
167
+ end if
168
+
169
+ call check(error, ios == 0 .and. iocmd == 0 , " Cannot create symlink!: " // trim (msg))
170
+ if (allocated (error)) return
171
+
172
+ t = exists(link_name, err)
173
+ call check(error, err% ok(), " exists failed for symlink: " // err% print ())
174
+
175
+ if (allocated (error)) then
176
+ ! Clean up: remove the link
177
+ call execute_command_line(" rm " // link_name, exitstat= ios, cmdstat= iocmd, cmdmsg= msg)
178
+ call check(error, ios == 0 .and. iocmd == 0 , err% message // " and &
179
+ & cannot delete link: " // trim (msg))
180
+
181
+ ! Clean up: remove the target
182
+ close (iunit,status= ' delete' ,iostat= ios,iomsg= msg)
183
+ call check(error, ios == 0 , err% message // " and cannot delete target: " // trim (msg))
184
+ return
185
+ end if
186
+
187
+ call check(error, t == type_symlink, " exists incorrectly identifies type of symlinks!" )
188
+
189
+ if (allocated (error)) then
190
+ ! Clean up: remove the link
191
+ call execute_command_line(" rm " // link_name, exitstat= ios, cmdstat= iocmd, cmdmsg= msg)
192
+ call check(error, ios == 0 .and. iocmd == 0 , err% message // " and &
193
+ & cannot delete link: " // trim (msg))
194
+
195
+ ! Clean up: remove the target
196
+ close (iunit,status= ' delete' ,iostat= ios,iomsg= msg)
197
+ call check(error, ios == 0 , err% message // " and cannot delete target: " // trim (msg))
198
+ return
199
+ end if
200
+
201
+ ! Clean up: remove the link
202
+ call execute_command_line(" rm " // link_name, exitstat= ios, cmdstat= iocmd, cmdmsg= msg)
203
+ call check(error, ios == 0 .and. iocmd == 0 , " Cannot delete link: " // trim (msg))
204
+
205
+ if (allocated (error)) then
206
+ ! Clean up: remove the target
207
+ close (iunit,status= ' delete' ,iostat= ios,iomsg= msg)
208
+ call check(error, ios == 0 , err% message // " and cannot delete target: " // trim (msg))
209
+ end if
210
+ end subroutine test_exists_symlink
211
+
52
212
! Test `is_directory` for a directory
53
213
subroutine test_is_directory_dir (error )
54
214
type (error_type), allocatable , intent (out ) :: error
0 commit comments