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