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'
5 ######################### We start with some black magic to print on failure.
7 BEGIN { $|= 1; print "1..267\n"; }
8 END {print "not ok 1\n" unless $loaded;}
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.
15 use Win32API::File qw(:ALL);
19 ######################### End of black magic.
26 $temp= $ENV{"TEMP"} unless -d $temp;
27 $temp= "C:/Temp" unless -d $temp;
28 $temp= "." unless -d $temp;
31 $ENV{WINDIR} = $ENV{SYSTEMROOT} if not exists $ENV{WINDIR};
34 or die "# Can't cd to temp directory, $temp: $!\n";
37 print "# deleting $temp\\$dir\\*\n" if glob "$dir/*";
43 rmdir $dir or die "Could not rmdir $dir: $!";
46 or die "# Can't create temp dir, $temp/$dir: $!\n";
47 print "# chdir $temp\\$dir\n";
49 or die "# Can't cd to my dir, $temp/$dir: $!\n";
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"); }
57 $ok= $h1= createFile( "ReadOnly.txt", "wcn", { Attributes=>"r" } );
58 $ok or print "# ",fileLastError(),"\n";
59 print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 3
61 $ok= WriteFile( $h1, "Original text\n", 0, [], [] );
62 $ok or print "# ",fileLastError(),"\n";
63 print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 4
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); }
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); }
77 $ok= $h2= createFile( "ReadOnly.txt", "r" );
78 $ok or print "# ",fileLastError(),"\n";
79 print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 7
81 $ok= SetFilePointer( $h1, length("Original"), [], FILE_BEGIN );
82 $ok or print "# ",fileLastError(),"\n";
83 print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 8
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
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
97 $ok= $text eq "Originally was other text\n";
99 $text =~ s/\r/\\r/g; $text =~ s/\n/\\n/g;
100 print "# <$text> should be <Originally was other text\\n>.\n";
102 print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 11
104 $ok= CloseHandle($h2);
105 $ok or print "# ",fileLastError(),"\n";
106 print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 12
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
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
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
124 $ok= $h2= createFile( "CanWrite.txt", "wk", { Share=>"rw" } );
125 $ok or print "# ",fileLastError(),"\n";
126 print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 16
128 $ok= OsFHandleOpen( "APP", $h2, "wat" );
129 $ok or print "# ",fileLastError(),"\n";
130 print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 17
132 $ok= $h2 == GetOsFHandle( "APP" );
133 $ok or print "# $h2 != ",GetOsFHandle("APP"),"\n";
134 print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 18
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
141 SetFilePointer($h1, 0, [], FILE_BEGIN) if $^O eq 'cygwin';
143 $ok= ReadFile( $h1, $text, 0, [], [] );
144 $ok or print "# ",fileLastError(),"\n";
145 print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 20
147 $ok= $text eq "is enough\r\n";
151 print "# <$text> should be <is enough\\r\\n>\n";
153 print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 21
156 if ($^O eq 'cygwin') {
158 $skip = " # skip cygwin can delete open files";
161 unlink("CanWrite.txt");
162 $ok= -e "CanWrite.txt" && $! =~ /permission denied/i;
163 $ok or print "# $!\n";
165 print $ok ? "" : "not ", "ok ", ++$test, "$skip\n"; # ok 22
167 close(APP); # Also does C<CloseHandle($h2)>
168 ## CloseHandle( $h2 );
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
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
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
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
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
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
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
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
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
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
220 $ok= MoveFile( "CanWrite.cp", "Moved.cp" );
221 $ok or print "# ",fileLastError(),"\n";
222 print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 33
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
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
236 system( "attrib -r Moved.cp" );
238 $ok= DeleteFile( "Moved.cp" );
239 $ok or print "# ",fileLastError(),"\n";
240 print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 36
242 $new= SEM_FAILCRITICALERRORS|SEM_NOOPENFILEERRORBOX;
243 $old= SetErrorMode( $new );
244 $renew= SetErrorMode( $old );
245 $reold= SetErrorMode( $old );
248 $ok or print "# $old != $reold: ",fileLastError(),"\n";
249 print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 37
251 $ok= ($renew&$new) == $new;
252 $ok or print "# $new != $renew: ",fileLastError(),"\n";
253 print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 38
255 $ok= @drives= getLogicalDrives();
256 $ok && print "# @drives\n";
257 $ok or print "# ",fileLastError(),"\n";
258 print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 39
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
265 $drive= substr( $ENV{WINDIR}, 0, 3 );
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
271 $ok= DRIVE_FIXED == GetDriveType( $drive );
273 "# ",DRIVE_FIXED," != ",GetDriveType($drive),": ",fileLastError(),"\n";
274 print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 42
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.
282 $ok= QueryDosDevice( $drive, $dev, 80 );
283 $ok or print "# $drive: ",fileLastError(),"\n";
285 ( $text= $dev ) =~ s/\0/\\0/g;
286 print "# $drive => $text\n";
288 print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 44
290 $bits= GetLogicalDrives();
293 while( $bit & $bits ) {
297 $let= pack( "C", $let + unpack("C","A") ) . ":";
298 print "# Querying undefined $let.\n";
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
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
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
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
319 $ok= DefineDosDevice( DDD_RAW_TARGET_PATH, $let, $dev );
321 ( $text= $dev ) =~ s/\0/\\0/g;
322 print "# $let,$text: ",fileLastError(),"\n";
324 print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 49
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
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
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
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
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
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
357 # GetVolumeInformation
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
363 # get first drive letters and use to test disk and storage IOCTLs
364 # "//./PhysicalDrive0"
368 my @consts= @Win32API::File::EXPORT_OK;
369 @consts{@consts}= @consts;
371 my( @noargs, %noargs )= qw(
372 attrLetsToBits fileLastError getLogicalDrives GetLogicalDrives );
373 @noargs{@noargs}= @noargs;
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]/;
380 $ok= ! eval("$func()") && $@ =~ /(::|\s)_?${func}A?[(:\s]/;
382 $ok or print "# $func: $@\n";
383 print $ok ? "" : "not ", "ok ", ++$test, "\n";
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";
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";
401 if (-e "$dir/ReadOnly.txt") {
402 chmod 0777, "$dir/ReadOnly.txt";
403 unlink "$dir/ReadOnly.txt";
405 unlink "$dir/CanWrite.txt" if -e "$dir/CanWrite.txt";