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