ext/Win32API-File/t/file.t

   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
   7 BEGIN {
   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 }
  21 END {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
  27 require Win32 unless defined &Win32::FormatMessage;
  28 use File::Spec;
  29 use Carp;
  30 use Carp::Heavy;
  31
  32 use Win32API::File qw(:ALL);
  33 $loaded = 1;
  34 print "ok 1\n";
  35
  36 ######################### End of black magic.
  37
  38 $test= 1;
  39
  40 use 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
  47 chdir( $temp )
  48   or  die "# Can't cd to temp directory, $temp: $!\n";
  49 $tempdir = File::Spec->catdir($temp,$dir);
  50 if(  -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 }
  59 mkdir( $dir, 0777 )
  60   or  die "# Can't create temp dir, $tempdir: $!\n";
  61 print "# chdir $tempdir\n";
  62 chdir( $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";
  67 print $ok ? "" : "not ", "ok ", ++$test, "\n";  # ok 2
  68 if(  ! $ok  ) {   CloseHandle($h1);   unlink("ReadOnly.txt");   }
  69
  70 $ok= $h1= createFile( "ReadOnly.txt", "wcn", { Attributes=>"r" } );
  71 $ok or print "# ",fileLastError(),"\n";
  72 print $ok ? "" : "not ", "ok ", ++$test, "\n";  # ok 3
  73
  74 $ok= WriteFile( $h1, "Original text\n", 0, [], [] );
  75 $ok or print "# ",fileLastError(),"\n";
  76 print $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";
  81 print $ok ? "" : "not ", "ok ", ++$test, "\n";  # ok 5
  82 if(  ! $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";
  87 print $ok ? "" : "not ", "ok ", ++$test, "\n";  # ok 6
  88 if(  ! $ok  ) {   CloseHandle($h2);   }
  89
  90 $ok= $h2= createFile( "ReadOnly.txt", "r" );
  91 $ok or print "# ",fileLastError(),"\n";
  92 print $ok ? "" : "not ", "ok ", ++$test, "\n";  # ok 7
  93
  94 $ok= SetFilePointer( $h1, length("Original"), [], FILE_BEGIN );
  95 $ok or print "# ",fileLastError(),"\n";
  96 print $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";
 102 print $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";
 108 print $ok ? "" : "not ", "ok ", ++$test, "\n";  # ok 10
 109
 110 $ok= $text eq "Originally was other text\n";
 111 if( !$ok ) {
 112     $text =~ s/\r/\\r/g;   $text =~ s/\n/\\n/g;
 113     print "# <$text> should be <Originally was other text\\n>.\n";
 114 }
 115 print $ok ? "" : "not ", "ok ", ++$test, "\n";  # ok 11
 116
 117 $ok= CloseHandle($h2);
 118 $ok or print "# ",fileLastError(),"\n";
 119 print $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";
 124 print $ok ? "" : "not ", "ok ", ++$test, "\n";  # ok 13
 125
 126 CloseHandle($h1);
 127
 128 $ok= $h1= createFile( "CanWrite.txt", "rw", FILE_SHARE_WRITE,
 129               { Create=>CREATE_ALWAYS } );
 130 $ok or print "# ",fileLastError(),"\n";
 131 print $ok ? "" : "not ", "ok ", ++$test, "\n";  # ok 14
 132
 133 $ok= WriteFile( $h1, "Just this and not this", 10, [], [] );
 134 $ok or print "# ",fileLastError(),"\n";
 135 print $ok ? "" : "not ", "ok ", ++$test, "\n";  # ok 15
 136
 137 $ok= $h2= createFile( "CanWrite.txt", "wk", { Share=>"rw" } );
 138 $ok or print "# ",fileLastError(),"\n";
 139 print $ok ? "" : "not ", "ok ", ++$test, "\n";  # ok 16
 140
 141 $ok= OsFHandleOpen( "APP", $h2, "wat" );
 142 $ok or print "# ",fileLastError(),"\n";
 143 print $ok ? "" : "not ", "ok ", ++$test, "\n";  # ok 17
 144
 145 $ok=  $h2 == GetOsFHandle( "APP" );
 146 $ok or print "# $h2 != ",GetOsFHandle("APP"),"\n";
 147 print $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";
 152 print $ok ? "" : "not ", "ok ", ++$test, "\n";  # ok 19
 153
 154 SetFilePointer($h1, 0, [], FILE_BEGIN) if $^O eq 'cygwin';
 155
 156 $ok= ReadFile( $h1, $text, 0, [], [] );
 157 $ok or print "# ",fileLastError(),"\n";
 158 print $ok ? "" : "not ", "ok ", ++$test, "\n";  # ok 20
 159
 160 $ok=  $text eq "is enough\r\n";
 161 if( !$ok ) {
 162     $text =~ s/\r/\\r/g;
 163     $text =~ s/\n/\\n/g;
 164     print "# <$text> should be <is enough\\r\\n>\n";
 165 }
 166 print $ok ? "" : "not ", "ok ", ++$test, "\n";  # ok 21
 167
 168 $skip = "";
 169 if ($^O eq 'cygwin') {
 170     $ok = 1;
 171     $skip = " # skip cygwin can delete open files";
 172 }
 173 else {
 174     unlink("CanWrite.txt");
 175     $ok = -e "CanWrite.txt" &&  $! =~ /permission denied/i;
 176     $ok or print "# $!\n";
 177 }
 178 print $ok ? "" : "not ", "ok ", ++$test, "$skip\n"; # ok 22
 179
 180 close(APP);             # Also does C<CloseHandle($h2)>
 181 ## CloseHandle( $h2 );
 182 CloseHandle( $h1 );
 183
 184 $ok= ! DeleteFile( "ReadOnly.txt" )
 185  &&  Win32API::File::_fileLastError() == 5; # access is denied
 186 $ok or print "# ",fileLastError(),"\n";
 187 print $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";
 192 print $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";
 197 print $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";
 202 print $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";
 207 print $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";
 212 print $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";
 217 print $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";
 222 print $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";
 228 print $ok ? "" : "not ", "ok ", ++$test, "\n";  # ok 31
 229
 230 $ok= MoveFileEx( "ReadOnly.cp", "CanWrite.cp", MOVEFILE_REPLACE_EXISTING );
 231 $ok or print "# ",fileLastError(),"\n";
 232 print $ok ? "" : "not ", "ok ", ++$test, "\n";  # ok 32
 233
 234 $ok= MoveFile( "CanWrite.cp", "Moved.cp" );
 235 $ok or print "# ",fileLastError(),"\n";
 236 print $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";
 243 print $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";
 248 print $ok ? "" : "not ", "ok ", ++$test, "\n";  # ok 35
 249
 250 if ($^O eq 'cygwin') {
 251     chmod( 0200 | 07777 & (stat("Moved.cp"))[2], "Moved.cp" );
 252 }
 253 else {
 254     system( "attrib -r Moved.cp" );
 255 }
 256
 257 $ok= DeleteFile( "Moved.cp" );
 258 $ok or print "# ",fileLastError(),"\n";
 259 print $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";
 268 print $ok ? "" : "not ", "ok ", ++$test, "\n";  # ok 37
 269
 270 $ok= ($renew&$new) == $new;
 271 $ok or print "# $new != $renew: ",fileLastError(),"\n";
 272 print $ok ? "" : "not ", "ok ", ++$test, "\n";  # ok 38
 273
 274 $ok= @drives= getLogicalDrives();
 275 $ok && print "# @drives\n";
 276 $ok or print "# ",fileLastError(),"\n";
 277 print $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";
 282 print $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";
 288 print $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";
 293 print $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";
 297 print $ok ? "" : "not ", "ok ", ++$test, "\n";  # ok 43
 298 $vol= $ser= $max= $flag= $fs= "";       # Prevent warnings.
 299
 300 chop($drive);
 301 $ok= QueryDosDevice( $drive, $dev, 80 );
 302 $ok or print "# $drive: ",fileLastError(),"\n";
 303 if( $ok ) {
 304     ( $text= $dev ) =~ s/\0/\\0/g;
 305     print "# $drive => $text\n";
 306 }
 307 print $ok ? "" : "not ", "ok ", ++$test, "\n";  # ok 44
 308
 309 $bits= GetLogicalDrives();
 310 $let= 25;
 311 $bit= 1<<$let;
 312 while(  $bit & $bits  ) {
 313     $let--;
 314     $bit >>= 1;
 315 }
 316 $let= pack( "C", $let + unpack("C","A") ) . ":";
 317 print "# Querying undefined $let.\n";
 318
 319 $ok= DefineDosDevice( 0, $let, $ENV{WINDIR} );
 320 $ok or print "# $let,$ENV{WINDIR}: ",fileLastError(),"\n";
 321 print $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";
 326 print $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";
 331 print $ok ? "" : "not ", "ok ", ++$test, "\n";  # ok 47
 332
 333 $ok= ! -f $let."/Win.ini"
 334   &&  $! =~ /no such file/i;
 335 $ok or print "# $!\n";
 336 print $ok ? "" : "not ", "ok ", ++$test, "\n";  # ok 48
 337
 338 $ok= DefineDosDevice( DDD_RAW_TARGET_PATH, $let, $dev );
 339 if( !$ok  ) {
 340     ( $text= $dev ) =~ s/\0/\\0/g;
 341     print "# $let,$text: ",fileLastError(),"\n";
 342 }
 343 print $ok ? "" : "not ", "ok ", ++$test, "\n";  # ok 49
 344
 345 $ok= -f $let.substr($ENV{WINDIR},3)."/win.ini";
 346 $ok or print "# ",fileLastError(),"\n";
 347 print $ok ? "" : "not ", "ok ", ++$test, "\n";  # ok 50
 348
 349 $ok= DefineDosDevice( DDD_REMOVE_DEFINITION|DDD_EXACT_MATCH_ON_REMOVE
 350                      |DDD_RAW_TARGET_PATH, $let, $dev );
 351 $ok or print "# $let,$dev: ",fileLastError(),"\n";
 352 print $ok ? "" : "not ", "ok ", ++$test, "\n";  # ok 51
 353
 354 my $path = $ENV{WINDIR};
 355 my $attrs = GetFileAttributes( $path );
 356 $ok= $attrs != INVALID_FILE_ATTRIBUTES;
 357 $ok or print "# $path gave invalid attribute value, attrs=$attrs: ",fileLastError(),"\n";
 358 print $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";
 362 print $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";
 368 print $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";
 372 print $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
 386 my %consts;
 387 my @consts= @Win32API::File::EXPORT_OK;
 388 @consts{@consts}= @consts;
 389
 390 my( @noargs, %noargs )= qw(
 391   attrLetsToBits fileLastError getLogicalDrives GetLogicalDrives );
 392 @noargs{@noargs}= @noargs;
 393
 394 foreach $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
 405 foreach $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
 413 foreach $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
 419 chdir( $temp );
 420 if (-e "$dir/ReadOnly.txt") {
 421     chmod 0777, "$dir/ReadOnly.txt";
 422     unlink "$dir/ReadOnly.txt";
 423 }
 424 unlink "$dir/CanWrite.txt" if -e "$dir/CanWrite.txt";
 425 rmdir $dir;
 426
 427 __END__