File: test_filesystem.f90

package info (click to toggle)
fortran-stdlib 0.8.1-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid
  • size: 34,008 kB
  • sloc: f90: 24,178; ansic: 1,244; cpp: 623; python: 119; makefile: 13
file content (568 lines) | stat: -rw-r--r-- 23,237 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
module test_filesystem
    use testdrive, only : new_unittest, unittest_type, error_type, check, skip_test
    use stdlib_system, only: is_directory, delete_file, FS_ERROR, FS_ERROR_CODE, &
        make_directory, remove_directory, make_directory_all, is_windows, OS_TYPE, &
        OS_WINDOWS, get_cwd, set_cwd, operator(/), exists, fs_type_unknown, &
        fs_type_regular_file, fs_type_directory, fs_type_symlink, is_file
    use stdlib_error, only: state_type, STDLIB_FS_ERROR
    use stdlib_strings, only: to_string

    implicit none

contains

    !> Collect all exported unit tests
    subroutine collect_suite(testsuite)
        !> Collection of tests
        type(unittest_type), allocatable, intent(out) :: testsuite(:)

        testsuite = [ &
            new_unittest("fs_error", test_fs_error), &
            new_unittest("fs_exists_not_exists", test_exists_not_exists), &
            new_unittest("fs_exists_reg_file", test_exists_reg_file), &
            new_unittest("fs_exists_dir", test_exists_dir), &
            new_unittest("fs_exists_symlink", test_exists_symlink), &
            new_unittest("fs_is_file", test_is_file), &
            new_unittest("fs_is_directory_dir", test_is_directory_dir), &
            new_unittest("fs_is_directory_file", test_is_directory_file), &
            new_unittest("fs_delete_non_existent", test_delete_file_non_existent), &
            new_unittest("fs_delete_existing_file", test_delete_file_existing), &
            new_unittest("fs_delete_file_being_dir", test_delete_directory), &
            new_unittest("fs_make_dir", test_make_directory), &
            new_unittest("fs_make_dir_existing_dir", test_make_directory_existing), &
            new_unittest("fs_make_dir_all", test_make_directory_all), &
            new_unittest("fs_remove_dir", test_remove_directory), &
            new_unittest("fs_remove_dir_non_existent", test_remove_directory_nonexistent), &
            new_unittest("fs_cwd", test_cwd) &
        ]
    end subroutine collect_suite

    subroutine test_fs_error(error)
        type(error_type), allocatable, intent(out) :: error
        type(state_type) :: s1, s2
        character(:), allocatable :: msg

        msg = "code - 10, Cannot create File temp.txt - File already exists"
        s1 = FS_ERROR_CODE(10, "Cannot create File temp.txt -", "File already exists")

        call check(error, s1%state == STDLIB_FS_ERROR .and. s1%message == msg, &
            "FS_ERROR_CODE: Could not construct the state with code correctly")
        if (allocated(error)) return

        msg = "Cannot create File temp.txt - File already exists"
        s2 = FS_ERROR("Cannot create File temp.txt -", "File already exists")

        call check(error, s2%state == STDLIB_FS_ERROR .and. s2%message == msg, &
            "FS_ERROR: Could not construct state without code correctly")
        if (allocated(error)) return
    end subroutine test_fs_error

    subroutine test_exists_not_exists(error)
        type(error_type), allocatable, intent(out) :: error
        type(state_type) :: err

        character(*), parameter :: path = "rand_name"
        integer :: t

        t = exists(path, err)
        call check(error, err%error(), "False positive for a non-existent path!")
    end subroutine test_exists_not_exists

    subroutine test_exists_reg_file(error)
        type(error_type), allocatable, intent(out) :: error
        type(state_type) :: err
        character(len=256) :: filename
        integer :: ios, iunit, t
        character(len=512) :: msg

        filename = "test_file.txt"

        ! Create a file
        open(newunit=iunit, file=filename, status="replace", iostat=ios, iomsg=msg)
        call check(error, ios == 0, "Cannot init test_exists_reg_file: " // trim(msg))
        if (allocated(error)) return

        t = exists(filename, err)
        call check(error, err%ok(), "exists failed for reg file: " // err%print())

        if (allocated(error)) then
            ! Clean up: remove the file
            close(iunit,status='delete',iostat=ios,iomsg=msg)
            call check(error, ios == 0, error%message// " and cannot delete test file: " // trim(msg))
            return
        end if

        call check(error, t == fs_type_regular_file, "exists incorrectly identifies type of &
            reg files!: type=" // to_string(t))

        if (allocated(error)) then
            ! Clean up: remove the file
            close(iunit,status='delete',iostat=ios,iomsg=msg)
            call check(error, ios == 0, error%message// " and cannot delete test file: " // trim(msg))
            return
        end if

        ! Clean up: remove the file
        close(iunit,status='delete',iostat=ios,iomsg=msg)
        call check(error, ios == 0, "Cannot delete test file: " // trim(msg))
        if (allocated(error)) return
    end subroutine test_exists_reg_file

    subroutine test_is_file(error)
        type(error_type), allocatable, intent(out) :: error
        character(len=256) :: filename
        integer :: ios, iunit
        character(len=512) :: msg

        logical :: is_reg_file

        filename = "test_file.txt"

        ! Create a file
        open(newunit=iunit, file=filename, status="replace", iostat=ios, iomsg=msg)
        call check(error, ios == 0, "Cannot init test_is_file: " // trim(msg))
        if (allocated(error)) return

        is_reg_file = is_file(filename)
        call check(error, is_reg_file, "is_file could not identify a file")

        if (allocated(error)) then
            ! Clean up: remove the file
            close(iunit,status='delete',iostat=ios,iomsg=msg)
            call check(error, ios == 0, error%message// " and cannot delete test file: " // trim(msg))
            return
        end if

        ! Clean up: remove the file
        close(iunit,status='delete',iostat=ios,iomsg=msg)
        call check(error, ios == 0, "Cannot delete test file: " // trim(msg))
        if (allocated(error)) return
    end subroutine test_is_file

    subroutine test_exists_dir(error)
        type(error_type), allocatable, intent(out) :: error
        type(state_type) :: err
        character(len=256) :: dirname
        integer :: ios, iocmd, t
        character(len=512) :: msg

        dirname = "temp_dir"

        ! Create a directory
        call execute_command_line("mkdir " // dirname, exitstat=ios, cmdstat=iocmd, cmdmsg=msg)
        call check(error, ios == 0 .and. iocmd == 0, "Cannot int test_exists_dir: " // trim(msg))
        if (allocated(error)) return

        t = exists(dirname, err)
        call check(error, err%ok(), "exists failed for directory: " // err%print())

        if (allocated(error)) then
            ! Clean up: remove the directory
            call execute_command_line("rmdir " // dirname, exitstat=ios, cmdstat=iocmd, cmdmsg=msg)
            call check(error, ios == 0 .and. iocmd == 0, error%message // " and &
                & cannot cleanup test_exists_dir: " // trim(msg))
            return
        end if

        call check(error, t == fs_type_directory, "exists incorrectly identifies type of &
            directories!: type=" // to_string(t))

        if (allocated(error)) then
            ! Clean up: remove the directory
            call execute_command_line("rmdir " // dirname, exitstat=ios, cmdstat=iocmd, cmdmsg=msg)
            call check(error, ios == 0 .and. iocmd == 0, error%message // " and &
                & cannot cleanup test_exists_dir: " // trim(msg))
            return
        end if

        ! Clean up: remove the directory
        call execute_command_line("rmdir " // dirname, exitstat=ios, cmdstat=iocmd, cmdmsg=msg)
        call check(error, ios == 0 .and. iocmd == 0, "Cannot cleanup test_exists_dir: " // trim(msg))
    end subroutine test_exists_dir

    subroutine test_exists_symlink(error)
        type(error_type), allocatable, intent(out) :: error
        type(state_type) :: err
        character(len=128) :: target_name, link_name
        integer :: ios, iunit, iocmd, t
        character(len=512) :: msg, cmd

        target_name = "test_file.txt"
        link_name = "symlink.txt"

        ! Create a file
        open(newunit=iunit, file=target_name, status="replace", iostat=ios, iomsg=msg)
        call check(error, ios == 0, "Cannot init test_exists_symlink: " // trim(msg))
        if (allocated(error)) return

        if (is_windows()) then
            cmd = 'mklink '//link_name//' '//target_name
            call execute_command_line(cmd, exitstat=ios, cmdstat=iocmd, cmdmsg=msg)
        else
            cmd = 'ln -s '//target_name//' '//link_name
            call execute_command_line(cmd, exitstat=ios, cmdstat=iocmd, cmdmsg=msg)
        end if

        call check(error, ios == 0 .and. iocmd == 0, "Cannot create symlink!: " // trim(msg))

        if (allocated(error)) then
            ! Clean up: remove the target
            close(iunit,status='delete',iostat=ios,iomsg=msg)
            call check(error, ios == 0, error%message // " and cannot delete target: " // trim(msg))
            return
        end if

        t = exists(link_name, err)
        call check(error, err%ok(), "exists failed for symlink: " // err%print())

        if (allocated(error)) then
            ! Clean up: remove the link
            call execute_command_line("rm " // link_name, exitstat=ios, cmdstat=iocmd, cmdmsg=msg)
            call check(error, ios == 0 .and. iocmd == 0, error%message // " and &
                & cannot delete link: " // trim(msg))

            ! Clean up: remove the target
            close(iunit,status='delete',iostat=ios,iomsg=msg)
            call check(error, ios == 0, error%message // " and cannot delete target: " // trim(msg))
            return
        end if

        call check(error, t == fs_type_symlink, "exists incorrectly identifies type of &
            symlinks!: type=" // to_string(t))

        if (allocated(error)) then
            ! Clean up: remove the link
            call execute_command_line("rm " // link_name, exitstat=ios, cmdstat=iocmd, cmdmsg=msg)
            call check(error, ios == 0 .and. iocmd == 0, error%message // " and &
                & cannot delete link: " // trim(msg))

            ! Clean up: remove the target
            close(iunit,status='delete',iostat=ios,iomsg=msg)
            call check(error, ios == 0, error%message // " and cannot delete target: " // trim(msg))
            return
        end if

        ! Clean up: remove the link
        call execute_command_line("rm " // link_name, exitstat=ios, cmdstat=iocmd, cmdmsg=msg)
        call check(error, ios == 0 .and. iocmd == 0, "Cannot delete link: " // trim(msg))

        if (allocated(error)) then
            ! Clean up: remove the target
            close(iunit,status='delete',iostat=ios,iomsg=msg)
            call check(error, ios == 0, error%message // " and cannot delete target: " // trim(msg))
        end if

        ! Clean up: remove the target
        close(iunit,status='delete',iostat=ios,iomsg=msg)
        call check(error, ios == 0, "Cannot delete target: " // trim(msg))
    end subroutine test_exists_symlink

    ! Test `is_directory` for a directory
    subroutine test_is_directory_dir(error)
        type(error_type), allocatable, intent(out) :: error
        character(len=256) :: dirname
        integer :: ios, iocmd
        character(len=512) :: msg

        dirname = "this_test_dir_tmp"

        ! Create a directory
        call execute_command_line("mkdir " // dirname, exitstat=ios, cmdstat=iocmd, cmdmsg=msg)
        call check(error, ios == 0 .and. iocmd == 0, "Cannot create test directory: " // trim(msg))
        if (allocated(error)) return

        ! Verify `is_directory` identifies it as a directory
        call check(error, is_directory(dirname), "is_directory did not recognize a valid directory")
        if (allocated(error)) return

        ! Clean up: remove the directory
        call execute_command_line("rmdir " // dirname, exitstat=ios, cmdstat=iocmd, cmdmsg=msg)
        call check(error, ios == 0 .and. iocmd == 0, "Cannot remove test directory: " // trim(msg))
    end subroutine test_is_directory_dir

    ! Test `is_directory` for a regular file
    subroutine test_is_directory_file(error)
        type(error_type), allocatable, intent(out) :: error
        character(len=256) :: filename
        logical :: result
        integer :: ios, iunit
        character(len=512) :: msg

        filename = "test_file.txt"

        ! Create a file
        open(newunit=iunit, file=filename, status="replace", iostat=ios, iomsg=msg)
        call check(error, ios == 0, "Cannot create test file: " // trim(msg))
        if (allocated(error)) return

        ! Verify `is_directory` identifies it as not a directory
        result = is_directory(filename)
        call check(error, .not. result, "is_directory falsely recognized a regular file as a directory")
        if (allocated(error)) return

        ! Clean up: remove the file
        close(iunit,status='delete',iostat=ios,iomsg=msg)
        call check(error, ios == 0, "Cannot delete test file: " // trim(msg))
        if (allocated(error)) return

    end subroutine test_is_directory_file

    subroutine test_delete_file_non_existent(error)
        !> Error handling
        type(error_type), allocatable, intent(out) :: error
        type(state_type) :: state

        ! Attempt to delete a file that doesn't exist
        call delete_file('non_existent_file.txt', state)

        call check(error, state%ok(), 'Error should not be triggered for non-existent file')
        if (allocated(error)) return

    end subroutine test_delete_file_non_existent

    subroutine test_delete_file_existing(error)
        !> Error handling
        type(error_type), allocatable, intent(out) :: error

        character(len=256) :: filename
        type(state_type) :: state
        integer :: ios,iunit
        logical :: is_present
        character(len=512) :: msg

        filename = 'existing_file.txt'

        ! Create a file to be deleted
        open(newunit=iunit, file=filename, status='replace', iostat=ios, iomsg=msg)
        call check(error, ios==0, 'Failed to create test file')
        if (allocated(error)) return
        close(iunit)

        ! Attempt to delete the existing file
        call delete_file(filename, state)

        ! Check deletion successful
        call check(error, state%ok(), 'delete_file returned '//state%print())
        if (allocated(error)) return

        ! Check if the file was successfully deleted (should no longer exist)
        inquire(file=filename, exist=is_present)

        call check(error, .not.is_present, 'File still present after delete')
        if (allocated(error)) return

    end subroutine test_delete_file_existing

    subroutine test_delete_directory(error)
        !> Error handling
        type(error_type), allocatable, intent(out) :: error
        character(len=256) :: filename
        type(state_type) :: state
        integer :: ios,iocmd
        character(len=512) :: msg

        filename = 'test_directory'

        ! The directory is not nested: it should be cross-platform to just call `mkdir`
        call execute_command_line('mkdir ' // filename, exitstat=ios, cmdstat=iocmd, cmdmsg=msg)
        call check(error, ios==0 .and. iocmd==0, 'Cannot init delete_directory test: '//trim(msg))
        if (allocated(error)) return

        ! Attempt to delete a directory (which should fail)
        call delete_file(filename, state)

        ! Check that an error was raised since the target is a directory
        call check(error, state%error(), 'Error was not triggered trying to delete directory')
        if (allocated(error)) return

        ! Clean up: remove the empty directory
        call execute_command_line('rmdir ' // filename, exitstat=ios, cmdstat=iocmd, cmdmsg=msg)
        call check(error, ios==0 .and. iocmd==0, 'Cannot cleanup delete_directory test: '//trim(msg))
        if (allocated(error)) return

    end subroutine test_delete_directory

    subroutine test_make_directory(error)
        type(error_type), allocatable, intent(out) :: error
        type(state_type) :: err
        character(len=256) :: dir_name
        integer :: ios,iocmd
        character(len=512) :: msg

        dir_name = "test_directory"

        call make_directory(dir_name, err=err)
        call check(error, err%ok(), 'Could not make directory: '//err%print())
        if (allocated(error)) return

        ! clean up: remove the empty directory
        call execute_command_line('rmdir ' // dir_name, exitstat=ios, cmdstat=iocmd, cmdmsg=msg)
        call check(error, ios==0 .and. iocmd==0, 'Cannot cleanup make_directory test: '//trim(msg))
    end subroutine test_make_directory

    subroutine test_make_directory_existing(error)
        type(error_type), allocatable, intent(out) :: error
        type(state_type) :: err
        character(len=256) :: dir_name
        integer :: ios,iocmd
        character(len=512) :: msg

        dir_name = "test_directory"

        call execute_command_line('mkdir ' // dir_name, exitstat=ios, cmdstat=iocmd, cmdmsg=msg)
        call check(error, ios==0 .and. iocmd==0, 'Cannot init make_directory_existing test: '//trim(msg))
        if (allocated(error)) return

        call make_directory(dir_name, err=err)
        call check(error, err%error(), 'Made an already existing directory somehow')

        ! clean up: remove the empty directory
        call execute_command_line('rmdir ' // dir_name, exitstat=ios, cmdstat=iocmd, cmdmsg=msg)

        if (allocated(error)) then
            ! if previous error is allocated as well
            call check(error, ios==0 .and. iocmd==0, error%message // ' and cannot cleanup make_directory test: '//trim(msg))
            return
        end if

        call check(error, ios==0 .and. iocmd==0, 'Cannot cleanup make_directory test: '//trim(msg))
    end subroutine test_make_directory_existing

    subroutine test_make_directory_all(error)
        type(error_type), allocatable, intent(out) :: error
        type(state_type) :: err
        character(len=256) :: dir_name
        integer :: ios,iocmd
        character(len=512) :: msg

        if (OS_TYPE() == OS_WINDOWS) then
            dir_name = "d1\d2\d3\d4\"
        else
            dir_name = "d1/d2/d3/d4/"
        end if

        call make_directory_all(dir_name, err=err)
        call check(error, err%ok(), 'Could not make all directories: '//err%print())
        if (allocated(error)) return

        ! clean up: remove the empty directory
        if (is_windows()) then
            call execute_command_line('rmdir /s /q d1', exitstat=ios, cmdstat=iocmd, cmdmsg=msg)
        else
            call execute_command_line('rm -rf d1', exitstat=ios, cmdstat=iocmd, cmdmsg=msg)
        end if

        call check(error, ios==0 .and. iocmd==0, 'Cannot cleanup make_directory_all test: '//trim(msg))
    end subroutine test_make_directory_all

    subroutine test_remove_directory(error)
        type(error_type), allocatable, intent(out) :: error
        type(state_type) :: err
        character(len=256) :: dir_name
        integer :: ios,iocmd
        character(len=512) :: msg

        dir_name = "test_directory"

        call execute_command_line('mkdir ' // dir_name, exitstat=ios, cmdstat=iocmd, cmdmsg=msg)
        call check(error, ios==0 .and. iocmd==0, 'Cannot init remove_directory test: '//trim(msg))
        if (allocated(error)) return

        call remove_directory(dir_name, err)
        call check(error, err%ok(), 'Could not remove directory: '//err%print())

        if (allocated(error)) then
            ! clean up: remove the empty directory
            call execute_command_line('rmdir ' // dir_name, exitstat=ios, cmdstat=iocmd, cmdmsg=msg)
            call check(error, ios==0 .and. iocmd==0, error%message // ' and cannot cleanup make_directory test: '//trim(msg))
        end if
    end subroutine test_remove_directory

    subroutine test_remove_directory_nonexistent(error)
        type(error_type), allocatable, intent(out) :: error
        type(state_type) :: err

        call remove_directory("random_name", err)
        call check(error, err%error(), 'Somehow removed a non-existent directory')
        if (allocated(error)) return
    end subroutine test_remove_directory_nonexistent

    subroutine test_cwd(error)
        type(error_type), allocatable, intent(out) :: error
        type(state_type) :: err
        character(len=256) :: dir_name
        integer :: ios,iocmd
        character(len=512) :: msg

        character(:), allocatable :: pwd1, pwd2, abs_dir_name

        ! get the initial cwd
        call get_cwd(pwd1, err)
        call check(error, err%ok(), 'Could not get current working directory: '//err%print())
        if (allocated(error)) return

        ! create a temporary directory for use by `set_cwd`
        dir_name = "test_directory"

        call execute_command_line('mkdir ' // dir_name, exitstat=ios, cmdstat=iocmd, cmdmsg=msg)
        call check(error, ios==0 .and. iocmd==0, 'Cannot init cwd test: '//trim(msg))
        if (allocated(error)) return

        abs_dir_name = pwd1 / dir_name
        call set_cwd(abs_dir_name, err)
        call check(error, err%ok(), 'Could not set current working directory: '//err%print())
        if (allocated(error)) return

        ! get the new cwd -> should be same as (pwd1 / dir_name)
        call get_cwd(pwd2, err)
        call check(error, err%ok(), 'Could not get current working directory: '//err%print())
        if (allocated(error)) return

        call check(error, pwd2 == abs_dir_name, 'Working directory is wrong, &
            & expected: '//abs_dir_name//" got: "//pwd2)
        if (allocated(error)) return

        ! cleanup: set the cwd back to the initial value
        call set_cwd(pwd1, err)
        call check(error, err%ok(), 'Could not clean up cwd test, could not set the cwd back: '//err%print())
        if (allocated(error)) then
            ! our cwd now is `./test_directory`
            ! there is no way of removing the empty test directory
            return
        end if

        ! cleanup: remove the empty directory
        call execute_command_line('rmdir ' // dir_name, exitstat=ios, cmdstat=iocmd, cmdmsg=msg)
        call check(error, ios==0 .and. iocmd==0, 'Cannot cleanup cwd test, cannot remove empty dir: '//trim(msg))
        if (allocated(error)) return
    end subroutine test_cwd

end module test_filesystem

program tester
    use, intrinsic :: iso_fortran_env, only : error_unit
    use testdrive, only : run_testsuite, new_testsuite, testsuite_type
    use test_filesystem, only : collect_suite

    implicit none

    integer :: stat, is
    type(testsuite_type), allocatable :: testsuites(:)
    character(len=*), parameter :: fmt = '("#", *(1x, a))'

    stat = 0

    testsuites = [ &
        new_testsuite("filesystem", collect_suite) &
    ]

    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 program