1
1
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
- make_directory, remove_directory
4
+ make_directory, remove_directory, make_directory_all, is_windows
5
5
use stdlib_error, only: state_type, STDLIB_FS_ERROR
6
6
7
7
implicit none
@@ -22,6 +22,7 @@ subroutine collect_suite(testsuite)
22
22
new_unittest(" fs_delete_file_being_dir" , test_delete_directory), &
23
23
new_unittest(" fs_make_dir" , test_make_directory), &
24
24
new_unittest(" fs_make_dir_existing_dir" , test_make_directory_existing), &
25
+ new_unittest(" fs_make_dir_all" , test_make_directory_all), &
25
26
new_unittest(" fs_remove_dir" , test_remove_directory), &
26
27
new_unittest(" fs_remove_dir_non_existent" , test_remove_directory_nonexistent) &
27
28
]
@@ -175,39 +176,39 @@ end subroutine test_delete_directory
175
176
subroutine test_make_directory (error )
176
177
type (error_type), allocatable , intent (out ) :: error
177
178
type (state_type) :: err
178
- character (len= 256 ) :: filename
179
+ character (len= 256 ) :: dir_name
179
180
integer :: ios,iocmd
180
181
character (len= 512 ) :: msg
181
182
182
- filename = " test_directory"
183
+ dir_name = " test_directory"
183
184
184
- call make_directory(filename , err= err)
185
+ call make_directory(dir_name , err= err)
185
186
call check(error, err% ok(), ' Could not make directory: ' // err% print ())
186
187
if (allocated (error)) return
187
188
188
189
! Clean up: remove the empty directory
189
- call execute_command_line(' rmdir ' // filename , exitstat= ios, cmdstat= iocmd, cmdmsg= msg)
190
+ call execute_command_line(' rmdir ' // dir_name , exitstat= ios, cmdstat= iocmd, cmdmsg= msg)
190
191
call check(error, ios== 0 .and. iocmd== 0 , ' Cannot cleanup make_directory test: ' // trim (msg))
191
192
end subroutine test_make_directory
192
193
193
194
subroutine test_make_directory_existing (error )
194
195
type (error_type), allocatable , intent (out ) :: error
195
196
type (state_type) :: err
196
- character (len= 256 ) :: filename
197
+ character (len= 256 ) :: dir_name
197
198
integer :: ios,iocmd
198
199
character (len= 512 ) :: msg
199
200
200
- filename = " test_directory"
201
+ dir_name = " test_directory"
201
202
202
- call execute_command_line(' mkdir ' // filename , exitstat= ios, cmdstat= iocmd, cmdmsg= msg)
203
+ call execute_command_line(' mkdir ' // dir_name , exitstat= ios, cmdstat= iocmd, cmdmsg= msg)
203
204
call check(error, ios== 0 .and. iocmd== 0 , ' Cannot init make_directory_existing test: ' // trim (msg))
204
205
if (allocated (error)) return
205
206
206
- call make_directory(filename , err= err)
207
+ call make_directory(dir_name , err= err)
207
208
call check(error, err% error(), ' Made an already existing directory somehow' )
208
209
209
210
! Clean up: remove the empty directory
210
- call execute_command_line(' rmdir ' // filename , exitstat= ios, cmdstat= iocmd, cmdmsg= msg)
211
+ call execute_command_line(' rmdir ' // dir_name , exitstat= ios, cmdstat= iocmd, cmdmsg= msg)
211
212
212
213
if (allocated (error)) then
213
214
! if previous error is allocated as well
@@ -218,25 +219,48 @@ subroutine test_make_directory_existing(error)
218
219
call check(error, ios== 0 .and. iocmd== 0 , ' Cannot cleanup make_directory test: ' // trim (msg))
219
220
end subroutine test_make_directory_existing
220
221
222
+ subroutine test_make_directory_all (error )
223
+ type (error_type), allocatable , intent (out ) :: error
224
+ type (state_type) :: err
225
+ character (len= 256 ) :: dir_name
226
+ integer :: ios,iocmd
227
+ character (len= 512 ) :: msg
228
+
229
+ dir_name = " d1/d2/d3/d4/"
230
+
231
+ call make_directory_all(dir_name, err= err)
232
+ call check(error, err% ok(), ' Could not make all directories: ' // err% print ())
233
+ if (allocated (error)) return
234
+
235
+ ! Clean up: remove the empty directory
236
+ if (is_windows()) then
237
+ call execute_command_line(' rmdir /s /q ' // dir_name, exitstat= ios, cmdstat= iocmd, cmdmsg= msg)
238
+ else
239
+ call execute_command_line(' rm -rf ' // dir_name, exitstat= ios, cmdstat= iocmd, cmdmsg= msg)
240
+ end if
241
+
242
+ call check(error, ios== 0 .and. iocmd== 0 , ' Cannot cleanup make_directory_all test: ' // trim (msg))
243
+ end subroutine test_make_directory_all
244
+
221
245
subroutine test_remove_directory (error )
222
246
type (error_type), allocatable , intent (out ) :: error
223
247
type (state_type) :: err
224
- character (len= 256 ) :: filename
248
+ character (len= 256 ) :: dir_name
225
249
integer :: ios,iocmd
226
250
character (len= 512 ) :: msg
227
251
228
- filename = " test_directory"
252
+ dir_name = " test_directory"
229
253
230
- call execute_command_line(' mkdir ' // filename , exitstat= ios, cmdstat= iocmd, cmdmsg= msg)
254
+ call execute_command_line(' mkdir ' // dir_name , exitstat= ios, cmdstat= iocmd, cmdmsg= msg)
231
255
call check(error, ios== 0 .and. iocmd== 0 , ' Cannot init remove_directory test: ' // trim (msg))
232
256
if (allocated (error)) return
233
257
234
- call remove_directory(filename , err)
258
+ call remove_directory(dir_name , err)
235
259
call check(error, err% ok(), ' Could not remove directory: ' // err% print ())
236
260
237
261
if (allocated (error)) then
238
262
! Clean up: remove the empty directory
239
- call execute_command_line(' rmdir ' // filename , exitstat= ios, cmdstat= iocmd, cmdmsg= msg)
263
+ call execute_command_line(' rmdir ' // dir_name , exitstat= ios, cmdstat= iocmd, cmdmsg= msg)
240
264
call check(error, ios== 0 .and. iocmd== 0 , error% message // ' and cannot cleanup make_directory test: ' // trim (msg))
241
265
end if
242
266
end subroutine test_remove_directory
0 commit comments