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 {
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..270\n";
20}
21END {print "not ok 1\n" unless $loaded;}
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.
26
27use Win32;
28use File::Spec;
29use Carp;
30use Carp::Heavy;
31
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
42$temp= File::Spec->tmpdir();
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";
49$tempdir = File::Spec->catdir($temp,$dir);
50if(  -d $dir  ) {
51    print "# deleting ",File::Spec->catdir($temp,$dir,'*'),"\n" if glob "$dir/*";
52
53    for (glob "$dir/*") {
54	chmod 0777, $_;
55	unlink $_;
56    }
57    rmdir $dir or die "Could not rmdir $dir: $!";
58}
59mkdir( $dir, 0777 )
60  or  die "# Can't create temp dir, $tempdir: $!\n";
61print "# chdir $tempdir\n";
62chdir( $dir )
63  or  die "# Can't cd to my dir, $tempdir: $!\n";
64$h1= createFile( "ReadOnly.txt", "r", { Attributes=>"r" } );
65$ok=  ! $h1  &&  Win32API::File::_fileLastError() == 2; # could not find the file
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  &&  Win32API::File::_fileLastError() == 80; # file exists
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  &&  Win32API::File::_fileLastError() == 5; # access is denied
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 &&  Win32API::File::_fileLastError() == 6; # handle is invalid
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 &&  Win32API::File::_fileLastError() == 5; # access is denied
186$ok or print "# ",fileLastError(),"\n";
187print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 23
188
189$ok= ! CopyFile( "ReadOnly.txt", "CanWrite.txt", 1 )
190 &&  Win32API::File::_fileLastError() == 80; # file exists
191$ok or print "# ",fileLastError(),"\n";
192print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 24
193
194$ok= ! CopyFile( "CanWrite.txt", "ReadOnly.txt", 0 )
195 &&  Win32API::File::_fileLastError() == 5; # access is denied
196$ok or print "# ",fileLastError(),"\n";
197print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 25
198
199$ok= ! MoveFile( "NoSuchFile", "NoSuchDest" )
200 &&  Win32API::File::_fileLastError() == 2; # not find the file
201$ok or print "# ",fileLastError(),"\n";
202print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 26
203
204$ok= ! MoveFileEx( "NoSuchFile", "NoSuchDest", 0 )
205 &&  Win32API::File::_fileLastError() == 2; # not find the file
206$ok or print "# ",fileLastError(),"\n";
207print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 27
208
209$ok= ! MoveFile( "ReadOnly.txt", "CanWrite.txt" )
210 &&  Win32API::File::_fileLastError() == 183; # file already exists
211$ok or print "# ",fileLastError(),"\n";
212print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 28
213
214$ok= ! MoveFileEx( "ReadOnly.txt", "CanWrite.txt", 0 )
215 &&  Win32API::File::_fileLastError() == 183; # file already exists
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 &&  (Win32API::File::_fileLastError() == 5     # access is denied
226 ||   Win32API::File::_fileLastError() == 183); # already exists
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" )
246 &&  Win32API::File::_fileLastError() == 5; # access is denied
247$ok or print "# ",fileLastError(),"\n";
248print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 35
249
250if ($^O eq 'cygwin') {
251    chmod( 0200 | 07777 & (stat("Moved.cp"))[2], "Moved.cp" );
252}
253else {
254    system( "attrib -r Moved.cp" );
255}
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
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";
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
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__
428