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