1
1
module test_filesystem
2
2
use testdrive, only : new_unittest, unittest_type, error_type, check, skip_test
3
- use stdlib_system, only: is_directory
3
+ use stdlib_system, only: is_directory, delete_file
4
+ use stdlib_error, only: state_type
4
5
5
6
implicit none
6
7
@@ -13,7 +14,10 @@ subroutine collect_suite(testsuite)
13
14
14
15
testsuite = [ &
15
16
new_unittest(" fs_is_directory_dir" , test_is_directory_dir), &
16
- new_unittest(" fs_is_directory_file" , test_is_directory_file) &
17
+ new_unittest(" fs_is_directory_file" , test_is_directory_file), &
18
+ new_unittest(" fs_delete_non_existent" , test_delete_file_non_existent), &
19
+ new_unittest(" fs_delete_existing_file" , test_delete_file_existing), &
20
+ new_unittest(" fs_delete_file_being_dir" , test_delete_directory) &
17
21
]
18
22
end subroutine collect_suite
19
23
@@ -67,6 +71,84 @@ subroutine test_is_directory_file(error)
67
71
68
72
end subroutine test_is_directory_file
69
73
74
+ subroutine test_delete_file_non_existent (error )
75
+ ! > Error handling
76
+ type (error_type), allocatable , intent (out ) :: error
77
+ type (state_type) :: state
78
+
79
+ ! Attempt to delete a file that doesn't exist
80
+ call delete_file(' non_existent_file.txt' , state)
81
+
82
+ call check(error, state% error(), ' Error should be triggered for non-existent file' )
83
+ if (allocated (error)) return
84
+
85
+ end subroutine test_delete_file_non_existent
86
+
87
+ subroutine test_delete_file_existing (error )
88
+ ! > Error handling
89
+ type (error_type), allocatable , intent (out ) :: error
90
+
91
+ character (len= 256 ) :: filename
92
+ type (state_type) :: state
93
+ integer :: ios,iunit
94
+ logical :: is_present
95
+ character (len= 512 ) :: msg
96
+
97
+ filename = ' existing_file.txt'
98
+
99
+ ! Create a file to be deleted
100
+ open (newunit= iunit, file= filename, status= ' replace' , iostat= ios, iomsg= msg)
101
+ call check(error, ios== 0 , ' Failed to create test file' )
102
+ if (allocated (error)) return
103
+ close (iunit)
104
+
105
+ ! Attempt to delete the existing file
106
+ call delete_file(filename, state)
107
+
108
+ ! Check deletion successful
109
+ call check(error, state% ok(), ' delete_file returned ' // state% print ())
110
+ if (allocated (error)) return
111
+
112
+ ! Check if the file was successfully deleted (should no longer exist)
113
+ inquire (file= filename, exist= is_present)
114
+
115
+ call check(error, .not. is_present, ' File still present after delete' )
116
+ if (allocated (error)) return
117
+
118
+ end subroutine test_delete_file_existing
119
+
120
+ subroutine test_delete_directory (error )
121
+ ! > Error handling
122
+ type (error_type), allocatable , intent (out ) :: error
123
+ character (len= 256 ) :: filename
124
+ type (state_type) :: state
125
+ integer :: ios,iocmd
126
+ character (len= 512 ) :: msg
127
+
128
+ filename = ' test_directory'
129
+
130
+ ! The directory is not nested: it should be cross-platform to just call `mkdir`
131
+ print * , ' mkdir'
132
+ call execute_command_line(' mkdir ' // filename, exitstat= ios, cmdstat= iocmd, cmdmsg= msg)
133
+ call check(error, ios== 0 .and. iocmd== 0 , ' Cannot init delete_directory test: ' // trim (msg))
134
+ if (allocated (error)) return
135
+
136
+ ! Attempt to delete a directory (which should fail)
137
+ print * , ' dfelete'
138
+ call delete_file(filename, state)
139
+
140
+ ! Check that an error was raised since the target is a directory
141
+ call check(error, state% error(), ' Error was not triggered trying to delete directory' )
142
+ if (allocated (error)) return
143
+
144
+ ! Clean up: remove the empty directory
145
+ print * , ' rmdir'
146
+ call execute_command_line(' rmdir ' // filename, exitstat= ios, cmdstat= iocmd, cmdmsg= msg)
147
+ call check(error, ios== 0 .and. iocmd== 0 , ' Cannot cleanup delete_directory test: ' // trim (msg))
148
+ if (allocated (error)) return
149
+
150
+ end subroutine test_delete_directory
151
+
70
152
71
153
end module test_filesystem
72
154
0 commit comments