This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: [PATCH] Re: Win32 modules & cygwin
[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
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
19 print "1..267\n";
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.
26use Win32;
27
00701878
SH
28use Win32API::File qw(:ALL);
29$loaded = 1;
30print "ok 1\n";
31
32######################### End of black magic.
33
34$test= 1;
35
36use strict qw(subs);
37
38$temp= $ENV{"TMP"};
39$temp= $ENV{"TEMP"} unless -d $temp;
40$temp= "C:/Temp" unless -d $temp;
41$temp= "." unless -d $temp;
42$dir= "W32ApiF.tmp";
43
44$ENV{WINDIR} = $ENV{SYSTEMROOT} if not exists $ENV{WINDIR};
45
46chdir( $temp )
47 or die "# Can't cd to temp directory, $temp: $!\n";
48
49if( -d $dir ) {
50 print "# deleting $temp\\$dir\\*\n" if glob "$dir/*";
51
52 for (glob "$dir/*") {
53 chmod 0777, $_;
54 unlink $_;
55 }
56 rmdir $dir or die "Could not rmdir $dir: $!";
57}
58mkdir( $dir, 0777 )
59 or die "# Can't create temp dir, $temp/$dir: $!\n";
60print "# chdir $temp\\$dir\n";
61chdir( $dir )
62 or die "# Can't cd to my dir, $temp/$dir: $!\n";
63
64$h1= createFile( "ReadOnly.txt", "r", { Attributes=>"r" } );
65$ok= ! $h1 && fileLastError() =~ /not find the file?/i;
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" );
79$ok= ! $h2 && fileLastError() =~ /file exists?/i;
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" );
85$ok= ! $h2 && fileLastError() =~ /access is denied?/i;
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, [] )
122 && fileLastError() =~ /handle is invalid?/i;
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");
175 $ok= -e "CanWrite.txt" && $! =~ /permission denied/i;
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" )
185 && fileLastError() =~ /access is denied?/i;
186$ok or print "# ",fileLastError(),"\n";
187print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 23
188
189$ok= ! CopyFile( "ReadOnly.txt", "CanWrite.txt", 1 )
190 && fileLastError() =~ /file exists?/i;
191$ok or print "# ",fileLastError(),"\n";
192print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 24
193
194$ok= ! CopyFile( "CanWrite.txt", "ReadOnly.txt", 0 )
195 && fileLastError() =~ /access is denied?/i;
196$ok or print "# ",fileLastError(),"\n";
197print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 25
198
199$ok= ! MoveFile( "NoSuchFile", "NoSuchDest" )
200 && fileLastError() =~ /not find the file/i;
201$ok or print "# ",fileLastError(),"\n";
202print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 26
203
204$ok= ! MoveFileEx( "NoSuchFile", "NoSuchDest", 0 )
205 && fileLastError() =~ /not find the file/i;
206$ok or print "# ",fileLastError(),"\n";
207print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 27
208
209$ok= ! MoveFile( "ReadOnly.txt", "CanWrite.txt" )
210 && fileLastError() =~ /file already exists?/i;
211$ok or print "# ",fileLastError(),"\n";
212print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 28
213
214$ok= ! MoveFileEx( "ReadOnly.txt", "CanWrite.txt", 0 )
215 && fileLastError() =~ /file already exists?/i;
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 )
225 && fileLastError() =~ /access is denied?|cannot create/i;
226$ok or print "# ",fileLastError(),"\n";
227print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 31
228
229$ok= MoveFileEx( "ReadOnly.cp", "CanWrite.cp", MOVEFILE_REPLACE_EXISTING );
230$ok or print "# ",fileLastError(),"\n";
231print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 32
232
233$ok= MoveFile( "CanWrite.cp", "Moved.cp" );
234$ok or print "# ",fileLastError(),"\n";
235print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 33
236
237$ok= ! unlink( "ReadOnly.cp" )
238 && $! =~ /no such file/i
239 && ! unlink( "CanWrite.cp" )
240 && $! =~ /no such file/i;
241$ok or print "# $!\n";
242print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 34
243
244$ok= ! DeleteFile( "Moved.cp" )
245 && fileLastError() =~ /access is denied?/i;
246$ok or print "# ",fileLastError(),"\n";
247print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 35
248
78ff2d7b
YST
249if ($^O eq 'cygwin') {
250 chmod( 0200 | 07777 & (stat("Moved.cp"))[2], "Moved.cp" );
251}
252else {
253 system( "attrib -r Moved.cp" );
254}
00701878
SH
255
256$ok= DeleteFile( "Moved.cp" );
257$ok or print "# ",fileLastError(),"\n";
258print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 36
259
260$new= SEM_FAILCRITICALERRORS|SEM_NOOPENFILEERRORBOX;
261$old= SetErrorMode( $new );
262$renew= SetErrorMode( $old );
263$reold= SetErrorMode( $old );
264
265$ok= $old == $reold;
266$ok or print "# $old != $reold: ",fileLastError(),"\n";
267print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 37
268
269$ok= ($renew&$new) == $new;
270$ok or print "# $new != $renew: ",fileLastError(),"\n";
271print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 38
272
273$ok= @drives= getLogicalDrives();
274$ok && print "# @drives\n";
275$ok or print "# ",fileLastError(),"\n";
276print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 39
277
278$ok= $drives[0] !~ /^[ab]/ || DRIVE_REMOVABLE == GetDriveType($drives[0]);
279$ok or print "# ",DRIVE_REMOVABLE," != ",GetDriveType($drives[0]),
280 ": ",fileLastError(),"\n";
281print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 40
282
283$drive= substr( $ENV{WINDIR}, 0, 3 );
284
285$ok= 1 == grep /^\Q$drive\E/i, @drives;
286$ok or print "# No $drive found in list of drives.\n";
287print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 41
288
289$ok= DRIVE_FIXED == GetDriveType( $drive );
290$ok or print
291 "# ",DRIVE_FIXED," != ",GetDriveType($drive),": ",fileLastError(),"\n";
292print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 42
293
294$ok= GetVolumeInformation( $drive, $vol, 64, $ser, $max, $flag, $fs, 16 );
295$ok or print "# ",fileLastError(),"\n";
296print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 43
297$vol= $ser= $max= $flag= $fs= ""; # Prevent warnings.
298
299chop($drive);
300$ok= QueryDosDevice( $drive, $dev, 80 );
301$ok or print "# $drive: ",fileLastError(),"\n";
302if( $ok ) {
303 ( $text= $dev ) =~ s/\0/\\0/g;
304 print "# $drive => $text\n";
305}
306print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 44
307
308$bits= GetLogicalDrives();
309$let= 25;
310$bit= 1<<$let;
311while( $bit & $bits ) {
312 $let--;
313 $bit >>= 1;
314}
315$let= pack( "C", $let + unpack("C","A") ) . ":";
316print "# Querying undefined $let.\n";
317
318$ok= DefineDosDevice( 0, $let, $ENV{WINDIR} );
319$ok or print "# $let,$ENV{WINDIR}: ",fileLastError(),"\n";
320print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 45
321
322$ok= -s $let."/Win.ini" == -s $ENV{WINDIR}."/Win.ini";
323$ok or print "# ", -s $let."/Win.ini", " vs. ",
324 -s $ENV{WINDIR}."/Win.ini", ": ",fileLastError(),"\n";
325print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 46
326
327$ok= DefineDosDevice( DDD_REMOVE_DEFINITION|DDD_EXACT_MATCH_ON_REMOVE,
328 $let, $ENV{WINDIR} );
329$ok or print "# $let,$ENV{WINDIR}: ",fileLastError(),"\n";
330print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 47
331
332$ok= ! -f $let."/Win.ini"
333 && $! =~ /no such file/i;
334$ok or print "# $!\n";
335print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 48
336
337$ok= DefineDosDevice( DDD_RAW_TARGET_PATH, $let, $dev );
338if( !$ok ) {
339 ( $text= $dev ) =~ s/\0/\\0/g;
340 print "# $let,$text: ",fileLastError(),"\n";
341}
342print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 49
343
344$ok= -f $let.substr($ENV{WINDIR},3)."/win.ini";
345$ok or print "# ",fileLastError(),"\n";
346print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 50
347
348$ok= DefineDosDevice( DDD_REMOVE_DEFINITION|DDD_EXACT_MATCH_ON_REMOVE
349 |DDD_RAW_TARGET_PATH, $let, $dev );
350$ok or print "# $let,$dev: ",fileLastError(),"\n";
351print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 51
352
353my $path = $ENV{WINDIR};
354my $attrs = GetFileAttributes( $path );
355$ok= $attrs != INVALID_FILE_ATTRIBUTES;
356$ok or print "# $path gave invalid attribute value, attrs=$attrs: ",fileLastError(),"\n";
357print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 52
358
359$ok= ($attrs & FILE_ATTRIBUTE_DIRECTORY);
360$ok or print "# $path not a directory, attrs=$attrs: ",fileLastError(),"\n";
361print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 53
362
363$path .= "/win.ini";
364$attrs = GetFileAttributes( $path );
365$ok= $attrs != INVALID_FILE_ATTRIBUTES;
366$ok or print "# $path gave invalid attribute value, attrs=$attrs: ",fileLastError(),"\n";
367print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 54
368
369$ok= !($attrs & FILE_ATTRIBUTE_DIRECTORY);
370$ok or print "# $path is a directory, attrs=$attrs: ",fileLastError(),"\n";
371print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 55
372
373# DefineDosDevice
374# GetFileType
375# GetVolumeInformation
376# QueryDosDevice
377#Add a drive letter that points to our temp directory
378#Add a drive letter that points to the drive our directory is in
379
380#winnt.t:
381# get first drive letters and use to test disk and storage IOCTLs
382# "//./PhysicalDrive0"
383# DeviceIoControl
384
385my %consts;
386my @consts= @Win32API::File::EXPORT_OK;
387@consts{@consts}= @consts;
388
389my( @noargs, %noargs )= qw(
390 attrLetsToBits fileLastError getLogicalDrives GetLogicalDrives );
391@noargs{@noargs}= @noargs;
392
393foreach $func ( @{$Win32API::File::EXPORT_TAGS{Func}} ) {
394 delete $consts{$func};
395 if( defined( $noargs{$func} ) ) {
396 $ok= ! eval("$func(0,0)") && $@ =~ /(::|\s)_?${func}A?[(:\s]/;
397 } else {
398 $ok= ! eval("$func()") && $@ =~ /(::|\s)_?${func}A?[(:\s]/;
399 }
400 $ok or print "# $func: $@\n";
401 print $ok ? "" : "not ", "ok ", ++$test, "\n";
402}
403
404foreach $func ( @{$Win32API::File::EXPORT_TAGS{FuncA}},
405 @{$Win32API::File::EXPORT_TAGS{FuncW}} ) {
406 $ok= ! eval("$func()") && $@ =~ /::_?${func}\(/;
407 delete $consts{$func};
408 $ok or print "# $func: $@\n";
409 print $ok ? "" : "not ", "ok ", ++$test, "\n";
410}
411
412foreach $const ( keys(%consts) ) {
413 $ok= eval("my \$x= $const(); 1");
414 $ok or print "# Constant $const: $@\n";
415 print $ok ? "" : "not ", "ok ", ++$test, "\n";
416}
417
418chdir( $temp );
419if (-e "$dir/ReadOnly.txt") {
420 chmod 0777, "$dir/ReadOnly.txt";
421 unlink "$dir/ReadOnly.txt";
422}
423unlink "$dir/CanWrite.txt" if -e "$dir/CanWrite.txt";
424rmdir $dir;
425
426__END__