@@ -17,11 +17,12 @@ subroutine collect_filesystem(testsuite)
17
17
type (unittest_type), allocatable , intent (out ) :: testsuite(:)
18
18
19
19
testsuite = [ &
20
- new_unittest(" fs_file_is_windows" , fs_is_windows), &
20
+ new_unittest(" fs_is_windows" , fs_is_windows), &
21
+ new_unittest(" fs_path_separator" , fs_path_separator), &
21
22
new_unittest(" fs_file_not_exists" , fs_file_not_exists, should_fail= .true. ), &
22
23
new_unittest(" fs_file_exists" , fs_file_exists), &
23
24
new_unittest(" fs_current_dir_exists" , fs_current_dir_exists), &
24
- new_unittest(" fs_path_separator " , fs_path_separator), &
25
+ new_unittest(" fs_use_path_separator " , fs_path_separator), &
25
26
new_unittest(" fs_run_invalid_command" , fs_run_invalid_command, should_fail= .true. ), &
26
27
new_unittest(" fs_run_with_invalid_option" , fs_run_with_invalid_option, should_fail= .true. ), &
27
28
new_unittest(" fs_run_valid_command" , fs_run_valid_command), &
@@ -48,6 +49,20 @@ subroutine fs_is_windows(error)
48
49
end if
49
50
end subroutine
50
51
52
+ subroutine fs_path_separator (error )
53
+ type (error_type), allocatable , intent (out ) :: error
54
+
55
+ character (len= 255 ) :: value
56
+ integer :: length, stat
57
+
58
+ call get_environment_variable(' HOMEDRIVE' , value, length, stat)
59
+ if (stat == 0 .and. length > 0 ) then
60
+ call check(error, path_separator == ' \\' , " Path separator should be set for Windows." )
61
+ else
62
+ call check(error, path_separator == ' /' , " Path separator should not be set for non-Windows." )
63
+ end if
64
+ end subroutine
65
+
51
66
subroutine fs_file_not_exists (error )
52
67
type (error_type), allocatable , intent (out ) :: error
53
68
@@ -61,12 +76,9 @@ subroutine fs_file_exists(error)
61
76
type (error_type), allocatable , intent (out ) :: error
62
77
63
78
logical :: is_existing
64
- integer :: unit
65
79
character (* ), parameter :: filename = " file.tmp"
66
80
67
- open (newunit= unit, file= filename)
68
- close (unit)
69
-
81
+ call create_file(filename)
70
82
is_existing = exists(filename)
71
83
call check(error, is_existing, " An existing file should not fail." )
72
84
call delete_file(filename)
@@ -81,7 +93,7 @@ subroutine fs_current_dir_exists(error)
81
93
call check(error, is_existing, " Current directory should not fail." )
82
94
end subroutine
83
95
84
- subroutine fs_path_separator (error )
96
+ subroutine fs_use_path_separator (error )
85
97
type (error_type), allocatable , intent (out ) :: error
86
98
87
99
character (* ), parameter :: outer_dir = " path_separator_outer"
@@ -156,10 +168,7 @@ subroutine fs_list_dir_one_file(error)
156
168
call test_failed(error, " Creating directory '" // temp_list_dir// " ' failed." ); return
157
169
end if
158
170
159
- call run(' touch ' // temp_list_dir// ' /' // filename, iostat= stat)
160
- if (stat /= 0 ) then
161
- call test_failed(error, " Creating file'" // filename// " ' in directory '" // temp_list_dir// " ' failed." ); return
162
- end if
171
+ call create_file(temp_list_dir// path_separator// filename)
163
172
164
173
call list_dir(temp_list_dir, files, stat)
165
174
call check(error, stat, " Listing the contents of an empty directory shouldn't fail." )
@@ -184,15 +193,8 @@ subroutine fs_list_dir_two_files(error)
184
193
call test_failed(error, " Creating directory '" // temp_list_dir// " ' failed." ); return
185
194
end if
186
195
187
- call run(' touch ' // temp_list_dir// ' /' // filename1, iostat= stat)
188
- if (stat /= 0 ) then
189
- call test_failed(error, " Creating file 1 in directory '" // temp_list_dir// " ' failed." ); return
190
- end if
191
-
192
- call run(' touch ' // temp_list_dir// ' /' // filename2, iostat= stat)
193
- if (stat /= 0 ) then
194
- call test_failed(error, " Creating file 2 in directory '" // temp_list_dir// " ' failed." ); return
195
- end if
196
+ call create_file(temp_list_dir// path_separator// filename1)
197
+ call create_file(temp_list_dir// path_separator// filename2)
196
198
197
199
call list_dir(temp_list_dir, files, stat)
198
200
call check(error, stat, " Listing the contents of an empty directory shouldn't fail." )
@@ -209,7 +211,7 @@ subroutine fs_list_dir_one_file_one_dir(error)
209
211
integer :: stat
210
212
211
213
type (string_type), allocatable :: contents(:)
212
- character (* ), parameter :: filename1 = ' abc.txt'
214
+ character (* ), parameter :: filename = ' abc.txt'
213
215
character (* ), parameter :: dir = ' xyz'
214
216
215
217
call rmdir(temp_list_dir)
@@ -218,24 +220,16 @@ subroutine fs_list_dir_one_file_one_dir(error)
218
220
call test_failed(error, " Creating directory '" // temp_list_dir// " ' failed." ); return
219
221
end if
220
222
221
- call run(' touch ' // temp_list_dir// ' /' // filename1, iostat= stat)
222
- if (stat /= 0 ) then
223
- call test_failed(error, " Creating file 1 in directory '" // temp_list_dir// " ' failed." ); return
224
- end if
225
-
226
- if (is_windows) then
227
- call mkdir(temp_list_dir// ' \' // dir, stat)
228
- else
229
- call mkdir(temp_list_dir// ' /' // dir, stat)
230
- end if
223
+ call create_file(temp_list_dir// path_separator// filename)
224
+ call mkdir(temp_list_dir// path_separator// dir, stat)
231
225
if (stat /= 0 ) then
232
226
call test_failed(error, " Creating dir in directory '" // temp_list_dir// " ' failed." ); return
233
227
end if
234
228
235
229
call list_dir(temp_list_dir, contents, stat)
236
230
call check(error, stat, " Listing the contents of an empty directory shouldn't fail." )
237
231
call check(error, size (contents) == 2 , " The directory should contain two files." )
238
- call check(error, char (contents(1 )) == filename1 , " The file should be '" // filename1 // " '." )
232
+ call check(error, char (contents(1 )) == filename , " The file should be '" // filename // " '." )
239
233
call check(error, char (contents(2 )) == dir, " The file should be '" // dir// " '." )
240
234
241
235
call rmdir(temp_list_dir)
@@ -263,15 +257,20 @@ subroutine fs_rmdir_with_contents(error)
263
257
call check(error, .not. exists(dir), " Directory should not exist." )
264
258
call mkdir(dir)
265
259
call check(error, exists(dir), " Directory should exist." )
266
- if (is_windows) then
267
- call mkdir(dir// ' \' // ' another_dir' )
268
- else
269
- call mkdir(dir// ' /' // ' another_dir' )
270
- end if
260
+ call mkdir(dir// path_separator// ' another_dir' )
271
261
call rmdir(dir)
272
262
call check(error, .not. exists(dir), " Directory should not exist." )
273
263
end subroutine
274
264
265
+ subroutine create_file (filename )
266
+ character (len=* ), intent (in ) :: filename
267
+
268
+ integer :: io
269
+
270
+ open (newunit= io, file= filename)
271
+ close (io)
272
+ end subroutine
273
+
275
274
subroutine delete_file (filename )
276
275
character (len=* ), intent (in ) :: filename
277
276
0 commit comments