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