This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update the FSF's address. Plus some other whitespace and NON-WHITESPACE
[perl5.git] / ext / 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
7BEGIN { $|= 1; print "1..267\n"; }
8END {print "not ok 1\n" unless $loaded;}
cf2f24a4
JD
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.
13use Win32;
14
00701878
SH
15use Win32API::File qw(:ALL);
16$loaded = 1;
17print "ok 1\n";
18
19######################### End of black magic.
20
21$test= 1;
22
23use 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
33chdir( $temp )
34 or die "# Can't cd to temp directory, $temp: $!\n";
35
36if( -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}
45mkdir( $dir, 0777 )
46 or die "# Can't create temp dir, $temp/$dir: $!\n";
47print "# chdir $temp\\$dir\n";
48chdir( $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";
54print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 2
55if( ! $ok ) { CloseHandle($h1); unlink("ReadOnly.txt"); }
56
57$ok= $h1= createFile( "ReadOnly.txt", "wcn", { Attributes=>"r" } );
58$ok or print "# ",fileLastError(),"\n";
59print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 3
60
61$ok= WriteFile( $h1, "Original text\n", 0, [], [] );
62$ok or print "# ",fileLastError(),"\n";
63print $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";
68print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 5
69if( ! $ok ) { CloseHandle($h2); }
70
71$h2= createFile( "ReadOnly.txt", "rwke" );
72$ok= ! $h2 && fileLastError() =~ /access is denied?/i;
73$ok or print "# ",fileLastError(),"\n";
74print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 6
75if( ! $ok ) { CloseHandle($h2); }
76
77$ok= $h2= createFile( "ReadOnly.txt", "r" );
78$ok or print "# ",fileLastError(),"\n";
79print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 7
80
81$ok= SetFilePointer( $h1, length("Original"), [], FILE_BEGIN );
82$ok or print "# ",fileLastError(),"\n";
83print $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";
89print $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";
95print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 10
96
97$ok= $text eq "Originally was other text\n";
98if( !$ok ) {
99 $text =~ s/\r/\\r/g; $text =~ s/\n/\\n/g;
100 print "# <$text> should be <Originally was other text\\n>.\n";
101}
102print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 11
103
104$ok= CloseHandle($h2);
105$ok or print "# ",fileLastError(),"\n";
106print $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";
111print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 13
112
113CloseHandle($h1);
114
115$ok= $h1= createFile( "CanWrite.txt", "rw", FILE_SHARE_WRITE,
116 { Create=>CREATE_ALWAYS } );
117$ok or print "# ",fileLastError(),"\n";
118print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 14
119
120$ok= WriteFile( $h1, "Just this and not this", 10, [], [] );
121$ok or print "# ",fileLastError(),"\n";
122print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 15
123
124$ok= $h2= createFile( "CanWrite.txt", "wk", { Share=>"rw" } );
125$ok or print "# ",fileLastError(),"\n";
126print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 16
127
128$ok= OsFHandleOpen( "APP", $h2, "wat" );
129$ok or print "# ",fileLastError(),"\n";
130print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 17
131
132$ok= $h2 == GetOsFHandle( "APP" );
133$ok or print "# $h2 != ",GetOsFHandle("APP"),"\n";
134print $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";
139print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 19
140
141SetFilePointer($h1, 0, [], FILE_BEGIN) if $^O eq 'cygwin';
142
143$ok= ReadFile( $h1, $text, 0, [], [] );
144$ok or print "# ",fileLastError(),"\n";
145print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 20
146
147$ok= $text eq "is enough\r\n";
148if( !$ok ) {
149 $text =~ s/\r/\\r/g;
150 $text =~ s/\n/\\n/g;
151 print "# <$text> should be <is enough\\r\\n>\n";
152}
153print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 21
154
155$skip = "";
156if ($^O eq 'cygwin') {
157 $ok = 1;
158 $skip = " # skip cygwin can delete open files";
159}
160else {
161 unlink("CanWrite.txt");
162 $ok= -e "CanWrite.txt" && $! =~ /permission denied/i;
163 $ok or print "# $!\n";
164}
165print $ok ? "" : "not ", "ok ", ++$test, "$skip\n"; # ok 22
166
167close(APP); # Also does C<CloseHandle($h2)>
168## CloseHandle( $h2 );
169CloseHandle( $h1 );
170
171$ok= ! DeleteFile( "ReadOnly.txt" )
172 && fileLastError() =~ /access is denied?/i;
173$ok or print "# ",fileLastError(),"\n";
174print $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";
179print $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";
184print $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";
189print $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";
194print $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";
199print $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";
204print $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";
209print $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";
214print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 31
215
216$ok= MoveFileEx( "ReadOnly.cp", "CanWrite.cp", MOVEFILE_REPLACE_EXISTING );
217$ok or print "# ",fileLastError(),"\n";
218print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 32
219
220$ok= MoveFile( "CanWrite.cp", "Moved.cp" );
221$ok or print "# ",fileLastError(),"\n";
222print $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";
229print $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";
234print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 35
235
78ff2d7b
YST
236if ($^O eq 'cygwin') {
237 chmod( 0200 | 07777 & (stat("Moved.cp"))[2], "Moved.cp" );
238}
239else {
240 system( "attrib -r Moved.cp" );
241}
00701878
SH
242
243$ok= DeleteFile( "Moved.cp" );
244$ok or print "# ",fileLastError(),"\n";
245print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 36
246
247$new= SEM_FAILCRITICALERRORS|SEM_NOOPENFILEERRORBOX;
248$old= SetErrorMode( $new );
249$renew= SetErrorMode( $old );
250$reold= SetErrorMode( $old );
251
252$ok= $old == $reold;
253$ok or print "# $old != $reold: ",fileLastError(),"\n";
254print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 37
255
256$ok= ($renew&$new) == $new;
257$ok or print "# $new != $renew: ",fileLastError(),"\n";
258print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 38
259
260$ok= @drives= getLogicalDrives();
261$ok && print "# @drives\n";
262$ok or print "# ",fileLastError(),"\n";
263print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 39
264
265$ok= $drives[0] !~ /^[ab]/ || DRIVE_REMOVABLE == GetDriveType($drives[0]);
266$ok or print "# ",DRIVE_REMOVABLE," != ",GetDriveType($drives[0]),
267 ": ",fileLastError(),"\n";
268print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 40
269
270$drive= substr( $ENV{WINDIR}, 0, 3 );
271
272$ok= 1 == grep /^\Q$drive\E/i, @drives;
273$ok or print "# No $drive found in list of drives.\n";
274print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 41
275
276$ok= DRIVE_FIXED == GetDriveType( $drive );
277$ok or print
278 "# ",DRIVE_FIXED," != ",GetDriveType($drive),": ",fileLastError(),"\n";
279print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 42
280
281$ok= GetVolumeInformation( $drive, $vol, 64, $ser, $max, $flag, $fs, 16 );
282$ok or print "# ",fileLastError(),"\n";
283print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 43
284$vol= $ser= $max= $flag= $fs= ""; # Prevent warnings.
285
286chop($drive);
287$ok= QueryDosDevice( $drive, $dev, 80 );
288$ok or print "# $drive: ",fileLastError(),"\n";
289if( $ok ) {
290 ( $text= $dev ) =~ s/\0/\\0/g;
291 print "# $drive => $text\n";
292}
293print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 44
294
295$bits= GetLogicalDrives();
296$let= 25;
297$bit= 1<<$let;
298while( $bit & $bits ) {
299 $let--;
300 $bit >>= 1;
301}
302$let= pack( "C", $let + unpack("C","A") ) . ":";
303print "# Querying undefined $let.\n";
304
305$ok= DefineDosDevice( 0, $let, $ENV{WINDIR} );
306$ok or print "# $let,$ENV{WINDIR}: ",fileLastError(),"\n";
307print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 45
308
309$ok= -s $let."/Win.ini" == -s $ENV{WINDIR}."/Win.ini";
310$ok or print "# ", -s $let."/Win.ini", " vs. ",
311 -s $ENV{WINDIR}."/Win.ini", ": ",fileLastError(),"\n";
312print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 46
313
314$ok= DefineDosDevice( DDD_REMOVE_DEFINITION|DDD_EXACT_MATCH_ON_REMOVE,
315 $let, $ENV{WINDIR} );
316$ok or print "# $let,$ENV{WINDIR}: ",fileLastError(),"\n";
317print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 47
318
319$ok= ! -f $let."/Win.ini"
320 && $! =~ /no such file/i;
321$ok or print "# $!\n";
322print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 48
323
324$ok= DefineDosDevice( DDD_RAW_TARGET_PATH, $let, $dev );
325if( !$ok ) {
326 ( $text= $dev ) =~ s/\0/\\0/g;
327 print "# $let,$text: ",fileLastError(),"\n";
328}
329print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 49
330
331$ok= -f $let.substr($ENV{WINDIR},3)."/win.ini";
332$ok or print "# ",fileLastError(),"\n";
333print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 50
334
335$ok= DefineDosDevice( DDD_REMOVE_DEFINITION|DDD_EXACT_MATCH_ON_REMOVE
336 |DDD_RAW_TARGET_PATH, $let, $dev );
337$ok or print "# $let,$dev: ",fileLastError(),"\n";
338print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 51
339
340my $path = $ENV{WINDIR};
341my $attrs = GetFileAttributes( $path );
342$ok= $attrs != INVALID_FILE_ATTRIBUTES;
343$ok or print "# $path gave invalid attribute value, attrs=$attrs: ",fileLastError(),"\n";
344print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 52
345
346$ok= ($attrs & FILE_ATTRIBUTE_DIRECTORY);
347$ok or print "# $path not a directory, attrs=$attrs: ",fileLastError(),"\n";
348print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 53
349
350$path .= "/win.ini";
351$attrs = GetFileAttributes( $path );
352$ok= $attrs != INVALID_FILE_ATTRIBUTES;
353$ok or print "# $path gave invalid attribute value, attrs=$attrs: ",fileLastError(),"\n";
354print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 54
355
356$ok= !($attrs & FILE_ATTRIBUTE_DIRECTORY);
357$ok or print "# $path is a directory, attrs=$attrs: ",fileLastError(),"\n";
358print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 55
359
360# DefineDosDevice
361# GetFileType
362# GetVolumeInformation
363# QueryDosDevice
364#Add a drive letter that points to our temp directory
365#Add a drive letter that points to the drive our directory is in
366
367#winnt.t:
368# get first drive letters and use to test disk and storage IOCTLs
369# "//./PhysicalDrive0"
370# DeviceIoControl
371
372my %consts;
373my @consts= @Win32API::File::EXPORT_OK;
374@consts{@consts}= @consts;
375
376my( @noargs, %noargs )= qw(
377 attrLetsToBits fileLastError getLogicalDrives GetLogicalDrives );
378@noargs{@noargs}= @noargs;
379
380foreach $func ( @{$Win32API::File::EXPORT_TAGS{Func}} ) {
381 delete $consts{$func};
382 if( defined( $noargs{$func} ) ) {
383 $ok= ! eval("$func(0,0)") && $@ =~ /(::|\s)_?${func}A?[(:\s]/;
384 } else {
385 $ok= ! eval("$func()") && $@ =~ /(::|\s)_?${func}A?[(:\s]/;
386 }
387 $ok or print "# $func: $@\n";
388 print $ok ? "" : "not ", "ok ", ++$test, "\n";
389}
390
391foreach $func ( @{$Win32API::File::EXPORT_TAGS{FuncA}},
392 @{$Win32API::File::EXPORT_TAGS{FuncW}} ) {
393 $ok= ! eval("$func()") && $@ =~ /::_?${func}\(/;
394 delete $consts{$func};
395 $ok or print "# $func: $@\n";
396 print $ok ? "" : "not ", "ok ", ++$test, "\n";
397}
398
399foreach $const ( keys(%consts) ) {
400 $ok= eval("my \$x= $const(); 1");
401 $ok or print "# Constant $const: $@\n";
402 print $ok ? "" : "not ", "ok ", ++$test, "\n";
403}
404
405chdir( $temp );
406if (-e "$dir/ReadOnly.txt") {
407 chmod 0777, "$dir/ReadOnly.txt";
408 unlink "$dir/ReadOnly.txt";
409}
410unlink "$dir/CanWrite.txt" if -e "$dir/CanWrite.txt";
411rmdir $dir;
412
413__END__