Commit | Line | Data |
00701878 |
1 | #!/usr/bin/perl -w |
2 | # Before `make install' is performed this script should be runnable with |
3 | # `make test'. After `make install' it should work as `perl test.pl' |
4 | |
5 | ######################### We start with some black magic to print on failure. |
6 | |
57d226e4 |
7 | BEGIN { |
8 | $|= 1; |
9 | |
10 | # when building perl, skip this test if Win32API::File isn't being built |
11 | if ( $ENV{PERL_CORE} ) { |
12 | require Config; |
13 | if ( $Config::Config{extensions} !~ m:(?<!\S)Win32API/File(?!\S): ) { |
14 | print "1..0 # Skip Win32API::File extension not built\n"; |
15 | exit(); |
16 | } |
17 | } |
18 | |
19 | print "1..267\n"; |
20 | } |
00701878 |
21 | END {print "not ok 1\n" unless $loaded;} |
cf2f24a4 |
22 | |
23 | # Win32API::File does an implicit "require Win32", but |
24 | # the ../lib directory in @INC will no longer work once |
25 | # we chdir() into the TEMP directory. |
de75d004 |
26 | |
cf2f24a4 |
27 | use Win32; |
de75d004 |
28 | use File::Spec; |
5a272364 |
29 | use Carp; |
30 | use Carp::Heavy; |
cf2f24a4 |
31 | |
00701878 |
32 | use Win32API::File qw(:ALL); |
33 | $loaded = 1; |
34 | print "ok 1\n"; |
35 | |
36 | ######################### End of black magic. |
37 | |
38 | $test= 1; |
39 | |
40 | use strict qw(subs); |
41 | |
de75d004 |
42 | $temp= File::Spec->tmpdir(); |
00701878 |
43 | $dir= "W32ApiF.tmp"; |
44 | |
45 | $ENV{WINDIR} = $ENV{SYSTEMROOT} if not exists $ENV{WINDIR}; |
46 | |
47 | chdir( $temp ) |
48 | or die "# Can't cd to temp directory, $temp: $!\n"; |
de75d004 |
49 | $tempdir = File::Spec->catdir($temp,$dir); |
00701878 |
50 | if( -d $dir ) { |
de75d004 |
51 | print "# deleting ",File::Spec->catdir($temp,$dir,'*'),"\n" if glob "$dir/*"; |
00701878 |
52 | |
53 | for (glob "$dir/*") { |
54 | chmod 0777, $_; |
55 | unlink $_; |
56 | } |
57 | rmdir $dir or die "Could not rmdir $dir: $!"; |
58 | } |
59 | mkdir( $dir, 0777 ) |
de75d004 |
60 | or die "# Can't create temp dir, $tempdir: $!\n"; |
61 | print "# chdir $tempdir\n"; |
00701878 |
62 | chdir( $dir ) |
de75d004 |
63 | or die "# Can't cd to my dir, $tempdir: $!\n"; |
00701878 |
64 | $h1= createFile( "ReadOnly.txt", "r", { Attributes=>"r" } ); |
de75d004 |
65 | $ok= ! $h1 && Win32API::File::_fileLastError() == 2; # could not find the file |
00701878 |
66 | $ok or print "# ","".fileLastError(),"\n"; |
67 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 2 |
68 | if( ! $ok ) { CloseHandle($h1); unlink("ReadOnly.txt"); } |
69 | |
70 | $ok= $h1= createFile( "ReadOnly.txt", "wcn", { Attributes=>"r" } ); |
71 | $ok or print "# ",fileLastError(),"\n"; |
72 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 3 |
73 | |
74 | $ok= WriteFile( $h1, "Original text\n", 0, [], [] ); |
75 | $ok or print "# ",fileLastError(),"\n"; |
76 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 4 |
77 | |
78 | $h2= createFile( "ReadOnly.txt", "rcn" ); |
de75d004 |
79 | $ok= ! $h2 && Win32API::File::_fileLastError() == 80; # file exists |
00701878 |
80 | $ok or print "# ",fileLastError(),"\n"; |
81 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 5 |
82 | if( ! $ok ) { CloseHandle($h2); } |
83 | |
84 | $h2= createFile( "ReadOnly.txt", "rwke" ); |
de75d004 |
85 | $ok= ! $h2 && Win32API::File::_fileLastError() == 5; # access is denied |
00701878 |
86 | $ok or print "# ",fileLastError(),"\n"; |
87 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 6 |
88 | if( ! $ok ) { CloseHandle($h2); } |
89 | |
90 | $ok= $h2= createFile( "ReadOnly.txt", "r" ); |
91 | $ok or print "# ",fileLastError(),"\n"; |
92 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 7 |
93 | |
94 | $ok= SetFilePointer( $h1, length("Original"), [], FILE_BEGIN ); |
95 | $ok or print "# ",fileLastError(),"\n"; |
96 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 8 |
97 | |
98 | $ok= WriteFile( $h1, "ly was other text\n", 0, $len, [] ) |
99 | && $len == length("ly was other text\n"); |
100 | $ok or print "# <$len> should be <", |
101 | length("ly was other text\n"),">: ",fileLastError(),"\n"; |
102 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 9 |
103 | |
104 | $ok= ReadFile( $h2, $text, 80, $len, [] ) |
105 | && $len == length($text); |
106 | $ok or print "# <$len> should be <",length($text), |
107 | ">: ",fileLastError(),"\n"; |
108 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 10 |
109 | |
110 | $ok= $text eq "Originally was other text\n"; |
111 | if( !$ok ) { |
112 | $text =~ s/\r/\\r/g; $text =~ s/\n/\\n/g; |
113 | print "# <$text> should be <Originally was other text\\n>.\n"; |
114 | } |
115 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 11 |
116 | |
117 | $ok= CloseHandle($h2); |
118 | $ok or print "# ",fileLastError(),"\n"; |
119 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 12 |
120 | |
121 | $ok= ! ReadFile( $h2, $text, 80, $len, [] ) |
de75d004 |
122 | && Win32API::File::_fileLastError() == 6; # handle is invalid |
00701878 |
123 | $ok or print "# ",fileLastError(),"\n"; |
124 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 13 |
125 | |
126 | CloseHandle($h1); |
127 | |
128 | $ok= $h1= createFile( "CanWrite.txt", "rw", FILE_SHARE_WRITE, |
129 | { Create=>CREATE_ALWAYS } ); |
130 | $ok or print "# ",fileLastError(),"\n"; |
131 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 14 |
132 | |
133 | $ok= WriteFile( $h1, "Just this and not this", 10, [], [] ); |
134 | $ok or print "# ",fileLastError(),"\n"; |
135 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 15 |
136 | |
137 | $ok= $h2= createFile( "CanWrite.txt", "wk", { Share=>"rw" } ); |
138 | $ok or print "# ",fileLastError(),"\n"; |
139 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 16 |
140 | |
141 | $ok= OsFHandleOpen( "APP", $h2, "wat" ); |
142 | $ok or print "# ",fileLastError(),"\n"; |
143 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 17 |
144 | |
145 | $ok= $h2 == GetOsFHandle( "APP" ); |
146 | $ok or print "# $h2 != ",GetOsFHandle("APP"),"\n"; |
147 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 18 |
148 | |
149 | { my $save= select(APP); $|= 1; select($save); } |
150 | $ok= print APP "is enough\n"; |
151 | $ok or print "# ",fileLastError(),"\n"; |
152 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 19 |
153 | |
154 | SetFilePointer($h1, 0, [], FILE_BEGIN) if $^O eq 'cygwin'; |
155 | |
156 | $ok= ReadFile( $h1, $text, 0, [], [] ); |
157 | $ok or print "# ",fileLastError(),"\n"; |
158 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 20 |
159 | |
160 | $ok= $text eq "is enough\r\n"; |
161 | if( !$ok ) { |
162 | $text =~ s/\r/\\r/g; |
163 | $text =~ s/\n/\\n/g; |
164 | print "# <$text> should be <is enough\\r\\n>\n"; |
165 | } |
166 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 21 |
167 | |
168 | $skip = ""; |
169 | if ($^O eq 'cygwin') { |
170 | $ok = 1; |
171 | $skip = " # skip cygwin can delete open files"; |
172 | } |
173 | else { |
174 | unlink("CanWrite.txt"); |
de75d004 |
175 | $ok = -e "CanWrite.txt" && $! =~ /permission denied/i; |
00701878 |
176 | $ok or print "# $!\n"; |
177 | } |
178 | print $ok ? "" : "not ", "ok ", ++$test, "$skip\n"; # ok 22 |
179 | |
180 | close(APP); # Also does C<CloseHandle($h2)> |
181 | ## CloseHandle( $h2 ); |
182 | CloseHandle( $h1 ); |
183 | |
184 | $ok= ! DeleteFile( "ReadOnly.txt" ) |
de75d004 |
185 | && Win32API::File::_fileLastError() == 5; # access is denied |
00701878 |
186 | $ok or print "# ",fileLastError(),"\n"; |
187 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 23 |
188 | |
189 | $ok= ! CopyFile( "ReadOnly.txt", "CanWrite.txt", 1 ) |
de75d004 |
190 | && Win32API::File::_fileLastError() == 80; # file exists |
00701878 |
191 | $ok or print "# ",fileLastError(),"\n"; |
192 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 24 |
193 | |
194 | $ok= ! CopyFile( "CanWrite.txt", "ReadOnly.txt", 0 ) |
de75d004 |
195 | && Win32API::File::_fileLastError() == 5; # access is denied |
00701878 |
196 | $ok or print "# ",fileLastError(),"\n"; |
197 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 25 |
198 | |
199 | $ok= ! MoveFile( "NoSuchFile", "NoSuchDest" ) |
de75d004 |
200 | && Win32API::File::_fileLastError() == 2; # not find the file |
00701878 |
201 | $ok or print "# ",fileLastError(),"\n"; |
202 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 26 |
203 | |
204 | $ok= ! MoveFileEx( "NoSuchFile", "NoSuchDest", 0 ) |
de75d004 |
205 | && Win32API::File::_fileLastError() == 2; # not find the file |
00701878 |
206 | $ok or print "# ",fileLastError(),"\n"; |
207 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 27 |
208 | |
209 | $ok= ! MoveFile( "ReadOnly.txt", "CanWrite.txt" ) |
de75d004 |
210 | && Win32API::File::_fileLastError() == 183; # file already exists |
00701878 |
211 | $ok or print "# ",fileLastError(),"\n"; |
212 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 28 |
213 | |
214 | $ok= ! MoveFileEx( "ReadOnly.txt", "CanWrite.txt", 0 ) |
de75d004 |
215 | && Win32API::File::_fileLastError() == 183; # file already exists |
00701878 |
216 | $ok or print "# ",fileLastError(),"\n"; |
217 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 29 |
218 | |
219 | $ok= CopyFile( "ReadOnly.txt", "ReadOnly.cp", 1 ) |
220 | && CopyFile( "CanWrite.txt", "CanWrite.cp", 1 ); |
221 | $ok or print "# ",fileLastError(),"\n"; |
222 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 30 |
223 | |
224 | $ok= ! MoveFileEx( "CanWrite.txt", "ReadOnly.cp", MOVEFILE_REPLACE_EXISTING ) |
de75d004 |
225 | && Win32API::File::_fileLastError() == 5; # access is denied |
00701878 |
226 | $ok or print "# ",fileLastError(),"\n"; |
227 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 31 |
228 | |
229 | $ok= MoveFileEx( "ReadOnly.cp", "CanWrite.cp", MOVEFILE_REPLACE_EXISTING ); |
230 | $ok or print "# ",fileLastError(),"\n"; |
231 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 32 |
232 | |
233 | $ok= MoveFile( "CanWrite.cp", "Moved.cp" ); |
234 | $ok or print "# ",fileLastError(),"\n"; |
235 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 33 |
236 | |
237 | $ok= ! unlink( "ReadOnly.cp" ) |
238 | && $! =~ /no such file/i |
239 | && ! unlink( "CanWrite.cp" ) |
240 | && $! =~ /no such file/i; |
241 | $ok or print "# $!\n"; |
242 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 34 |
243 | |
244 | $ok= ! DeleteFile( "Moved.cp" ) |
de75d004 |
245 | && Win32API::File::_fileLastError() == 5; # access is denied |
00701878 |
246 | $ok or print "# ",fileLastError(),"\n"; |
247 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 35 |
248 | |
78ff2d7b |
249 | if ($^O eq 'cygwin') { |
250 | chmod( 0200 | 07777 & (stat("Moved.cp"))[2], "Moved.cp" ); |
251 | } |
252 | else { |
253 | system( "attrib -r Moved.cp" ); |
254 | } |
00701878 |
255 | |
256 | $ok= DeleteFile( "Moved.cp" ); |
257 | $ok or print "# ",fileLastError(),"\n"; |
258 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 36 |
259 | |
260 | $new= SEM_FAILCRITICALERRORS|SEM_NOOPENFILEERRORBOX; |
261 | $old= SetErrorMode( $new ); |
262 | $renew= SetErrorMode( $old ); |
263 | $reold= SetErrorMode( $old ); |
264 | |
265 | $ok= $old == $reold; |
266 | $ok or print "# $old != $reold: ",fileLastError(),"\n"; |
267 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 37 |
268 | |
269 | $ok= ($renew&$new) == $new; |
270 | $ok or print "# $new != $renew: ",fileLastError(),"\n"; |
271 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 38 |
272 | |
273 | $ok= @drives= getLogicalDrives(); |
274 | $ok && print "# @drives\n"; |
275 | $ok or print "# ",fileLastError(),"\n"; |
276 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 39 |
277 | |
278 | $ok= $drives[0] !~ /^[ab]/ || DRIVE_REMOVABLE == GetDriveType($drives[0]); |
279 | $ok or print "# ",DRIVE_REMOVABLE," != ",GetDriveType($drives[0]), |
280 | ": ",fileLastError(),"\n"; |
281 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 40 |
282 | |
283 | $drive= substr( $ENV{WINDIR}, 0, 3 ); |
284 | |
285 | $ok= 1 == grep /^\Q$drive\E/i, @drives; |
286 | $ok or print "# No $drive found in list of drives.\n"; |
287 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 41 |
288 | |
289 | $ok= DRIVE_FIXED == GetDriveType( $drive ); |
290 | $ok or print |
291 | "# ",DRIVE_FIXED," != ",GetDriveType($drive),": ",fileLastError(),"\n"; |
292 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 42 |
293 | |
294 | $ok= GetVolumeInformation( $drive, $vol, 64, $ser, $max, $flag, $fs, 16 ); |
295 | $ok or print "# ",fileLastError(),"\n"; |
296 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 43 |
297 | $vol= $ser= $max= $flag= $fs= ""; # Prevent warnings. |
298 | |
299 | chop($drive); |
300 | $ok= QueryDosDevice( $drive, $dev, 80 ); |
301 | $ok or print "# $drive: ",fileLastError(),"\n"; |
302 | if( $ok ) { |
303 | ( $text= $dev ) =~ s/\0/\\0/g; |
304 | print "# $drive => $text\n"; |
305 | } |
306 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 44 |
307 | |
308 | $bits= GetLogicalDrives(); |
309 | $let= 25; |
310 | $bit= 1<<$let; |
311 | while( $bit & $bits ) { |
312 | $let--; |
313 | $bit >>= 1; |
314 | } |
315 | $let= pack( "C", $let + unpack("C","A") ) . ":"; |
316 | print "# Querying undefined $let.\n"; |
317 | |
318 | $ok= DefineDosDevice( 0, $let, $ENV{WINDIR} ); |
319 | $ok or print "# $let,$ENV{WINDIR}: ",fileLastError(),"\n"; |
320 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 45 |
321 | |
322 | $ok= -s $let."/Win.ini" == -s $ENV{WINDIR}."/Win.ini"; |
323 | $ok or print "# ", -s $let."/Win.ini", " vs. ", |
324 | -s $ENV{WINDIR}."/Win.ini", ": ",fileLastError(),"\n"; |
325 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 46 |
326 | |
327 | $ok= DefineDosDevice( DDD_REMOVE_DEFINITION|DDD_EXACT_MATCH_ON_REMOVE, |
328 | $let, $ENV{WINDIR} ); |
329 | $ok or print "# $let,$ENV{WINDIR}: ",fileLastError(),"\n"; |
330 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 47 |
331 | |
332 | $ok= ! -f $let."/Win.ini" |
333 | && $! =~ /no such file/i; |
334 | $ok or print "# $!\n"; |
335 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 48 |
336 | |
337 | $ok= DefineDosDevice( DDD_RAW_TARGET_PATH, $let, $dev ); |
338 | if( !$ok ) { |
339 | ( $text= $dev ) =~ s/\0/\\0/g; |
340 | print "# $let,$text: ",fileLastError(),"\n"; |
341 | } |
342 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 49 |
343 | |
344 | $ok= -f $let.substr($ENV{WINDIR},3)."/win.ini"; |
345 | $ok or print "# ",fileLastError(),"\n"; |
346 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 50 |
347 | |
348 | $ok= DefineDosDevice( DDD_REMOVE_DEFINITION|DDD_EXACT_MATCH_ON_REMOVE |
349 | |DDD_RAW_TARGET_PATH, $let, $dev ); |
350 | $ok or print "# $let,$dev: ",fileLastError(),"\n"; |
351 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 51 |
352 | |
353 | my $path = $ENV{WINDIR}; |
354 | my $attrs = GetFileAttributes( $path ); |
355 | $ok= $attrs != INVALID_FILE_ATTRIBUTES; |
356 | $ok or print "# $path gave invalid attribute value, attrs=$attrs: ",fileLastError(),"\n"; |
357 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 52 |
358 | |
359 | $ok= ($attrs & FILE_ATTRIBUTE_DIRECTORY); |
360 | $ok or print "# $path not a directory, attrs=$attrs: ",fileLastError(),"\n"; |
361 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 53 |
362 | |
363 | $path .= "/win.ini"; |
364 | $attrs = GetFileAttributes( $path ); |
365 | $ok= $attrs != INVALID_FILE_ATTRIBUTES; |
366 | $ok or print "# $path gave invalid attribute value, attrs=$attrs: ",fileLastError(),"\n"; |
367 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 54 |
368 | |
369 | $ok= !($attrs & FILE_ATTRIBUTE_DIRECTORY); |
370 | $ok or print "# $path is a directory, attrs=$attrs: ",fileLastError(),"\n"; |
371 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 55 |
372 | |
373 | # DefineDosDevice |
374 | # GetFileType |
375 | # GetVolumeInformation |
376 | # QueryDosDevice |
377 | #Add a drive letter that points to our temp directory |
378 | #Add a drive letter that points to the drive our directory is in |
379 | |
380 | #winnt.t: |
381 | # get first drive letters and use to test disk and storage IOCTLs |
382 | # "//./PhysicalDrive0" |
383 | # DeviceIoControl |
384 | |
385 | my %consts; |
386 | my @consts= @Win32API::File::EXPORT_OK; |
387 | @consts{@consts}= @consts; |
388 | |
389 | my( @noargs, %noargs )= qw( |
390 | attrLetsToBits fileLastError getLogicalDrives GetLogicalDrives ); |
391 | @noargs{@noargs}= @noargs; |
392 | |
393 | foreach $func ( @{$Win32API::File::EXPORT_TAGS{Func}} ) { |
394 | delete $consts{$func}; |
395 | if( defined( $noargs{$func} ) ) { |
396 | $ok= ! eval("$func(0,0)") && $@ =~ /(::|\s)_?${func}A?[(:\s]/; |
397 | } else { |
398 | $ok= ! eval("$func()") && $@ =~ /(::|\s)_?${func}A?[(:\s]/; |
399 | } |
400 | $ok or print "# $func: $@\n"; |
401 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; |
402 | } |
403 | |
404 | foreach $func ( @{$Win32API::File::EXPORT_TAGS{FuncA}}, |
405 | @{$Win32API::File::EXPORT_TAGS{FuncW}} ) { |
406 | $ok= ! eval("$func()") && $@ =~ /::_?${func}\(/; |
407 | delete $consts{$func}; |
408 | $ok or print "# $func: $@\n"; |
409 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; |
410 | } |
411 | |
412 | foreach $const ( keys(%consts) ) { |
413 | $ok= eval("my \$x= $const(); 1"); |
414 | $ok or print "# Constant $const: $@\n"; |
415 | print $ok ? "" : "not ", "ok ", ++$test, "\n"; |
416 | } |
417 | |
418 | chdir( $temp ); |
419 | if (-e "$dir/ReadOnly.txt") { |
420 | chmod 0777, "$dir/ReadOnly.txt"; |
421 | unlink "$dir/ReadOnly.txt"; |
422 | } |
423 | unlink "$dir/CanWrite.txt" if -e "$dir/CanWrite.txt"; |
424 | rmdir $dir; |
425 | |
426 | __END__ |