[p5sagit/p5-mst-13.2.git] / ext / Win32API-File / t / file.t

#!/usr/bin/perl -w
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'

######################### We start with some black magic to print on failure.

BEGIN {
    $|= 1;

    # when building perl, skip this test if Win32API::File isn't being built
    if ( $ENV{PERL_CORE} ) {
	require Config;
	if ( $Config::Config{extensions} !~ m:(?<!\S)Win32API/File(?!\S): ) {
	    print "1..0 # Skip Win32API::File extension not built\n";
	    exit();
	}
    }

    print "1..267\n";
}
END {print "not ok 1\n" unless $loaded;}

# Win32API::File does an implicit "require Win32", but
# the ../lib directory in @INC will no longer work once
# we chdir() into the TEMP directory.

require Win32 unless defined &Win32::FormatMessage;
use File::Spec;
use Carp;
use Carp::Heavy;

use Win32API::File qw(:ALL);
$loaded = 1;
print "ok 1\n";

######################### End of black magic.

$test= 1;

use strict qw(subs);

$temp= File::Spec->tmpdir();
$dir= "W32ApiF.tmp";

$ENV{WINDIR} = $ENV{SYSTEMROOT} if not exists $ENV{WINDIR};

chdir( $temp )
  or  die "# Can't cd to temp directory, $temp: $!\n";
$tempdir = File::Spec->catdir($temp,$dir);
if(  -d $dir  ) {
    print "# deleting ",File::Spec->catdir($temp,$dir,'*'),"\n" if glob "$dir/*";

    for (glob "$dir/*") {
	chmod 0777, $_;
	unlink $_;
    }
    rmdir $dir or die "Could not rmdir $dir: $!";
}
mkdir( $dir, 0777 )
  or  die "# Can't create temp dir, $tempdir: $!\n";
print "# chdir $tempdir\n";
chdir( $dir )
  or  die "# Can't cd to my dir, $tempdir: $!\n";
$h1= createFile( "ReadOnly.txt", "r", { Attributes=>"r" } );
$ok=  ! $h1  &&  Win32API::File::_fileLastError() == 2; # could not find the file
$ok or print "# ","".fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 2
if(  ! $ok  ) {   CloseHandle($h1);   unlink("ReadOnly.txt");   }

$ok= $h1= createFile( "ReadOnly.txt", "wcn", { Attributes=>"r" } );
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 3

$ok= WriteFile( $h1, "Original text\n", 0, [], [] );
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 4

$h2= createFile( "ReadOnly.txt", "rcn" );
$ok= ! $h2  &&  Win32API::File::_fileLastError() == 80; # file exists
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 5
if(  ! $ok  ) {   CloseHandle($h2);   }

$h2= createFile( "ReadOnly.txt", "rwke" );
$ok= ! $h2  &&  Win32API::File::_fileLastError() == 5; # access is denied
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 6
if(  ! $ok  ) {   CloseHandle($h2);   }

$ok= $h2= createFile( "ReadOnly.txt", "r" );
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 7

$ok= SetFilePointer( $h1, length("Original"), [], FILE_BEGIN );
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 8

$ok= WriteFile( $h1, "ly was other text\n", 0, $len, [] )
  &&  $len == length("ly was other text\n");
$ok or print "# <$len> should be <",
  length("ly was other text\n"),">: ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 9

$ok= ReadFile( $h2, $text, 80, $len, [] )
 &&  $len == length($text);
$ok or print "# <$len> should be <",length($text),
  ">: ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 10

$ok= $text eq "Originally was other text\n";
if( !$ok ) {
    $text =~ s/\r/\\r/g;   $text =~ s/\n/\\n/g;
    print "# <$text> should be <Originally was other text\\n>.\n";
}
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 11

$ok= CloseHandle($h2);
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 12

$ok= ! ReadFile( $h2, $text, 80, $len, [] )
 &&  Win32API::File::_fileLastError() == 6; # handle is invalid
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 13

CloseHandle($h1);

$ok= $h1= createFile( "CanWrite.txt", "rw", FILE_SHARE_WRITE,
	      { Create=>CREATE_ALWAYS } );
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 14

$ok= WriteFile( $h1, "Just this and not this", 10, [], [] );
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 15

$ok= $h2= createFile( "CanWrite.txt", "wk", { Share=>"rw" } );
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 16

$ok= OsFHandleOpen( "APP", $h2, "wat" );
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 17

$ok=  $h2 == GetOsFHandle( "APP" );
$ok or print "# $h2 != ",GetOsFHandle("APP"),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 18

{   my $save= select(APP);   $|= 1;  select($save);   }
$ok= print APP "is enough\n";
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 19

SetFilePointer($h1, 0, [], FILE_BEGIN) if $^O eq 'cygwin';

$ok= ReadFile( $h1, $text, 0, [], [] );
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 20

$ok=  $text eq "is enough\r\n";
if( !$ok ) {
    $text =~ s/\r/\\r/g;
    $text =~ s/\n/\\n/g;
    print "# <$text> should be <is enough\\r\\n>\n";
}
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 21

$skip = "";
if ($^O eq 'cygwin') {
    $ok = 1;
    $skip = " # skip cygwin can delete open files";
}
else {
    unlink("CanWrite.txt");
    $ok = -e "CanWrite.txt" &&  $! =~ /permission denied/i;
    $ok or print "# $!\n";
}
print $ok ? "" : "not ", "ok ", ++$test, "$skip\n"; # ok 22

close(APP);		# Also does C<CloseHandle($h2)>
## CloseHandle( $h2 );
CloseHandle( $h1 );

$ok= ! DeleteFile( "ReadOnly.txt" )
 &&  Win32API::File::_fileLastError() == 5; # access is denied
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 23

$ok= ! CopyFile( "ReadOnly.txt", "CanWrite.txt", 1 )
 &&  Win32API::File::_fileLastError() == 80; # file exists
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 24

$ok= ! CopyFile( "CanWrite.txt", "ReadOnly.txt", 0 )
 &&  Win32API::File::_fileLastError() == 5; # access is denied
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 25

$ok= ! MoveFile( "NoSuchFile", "NoSuchDest" )
 &&  Win32API::File::_fileLastError() == 2; # not find the file
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 26

$ok= ! MoveFileEx( "NoSuchFile", "NoSuchDest", 0 )
 &&  Win32API::File::_fileLastError() == 2; # not find the file
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 27

$ok= ! MoveFile( "ReadOnly.txt", "CanWrite.txt" )
 &&  Win32API::File::_fileLastError() == 183; # file already exists
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 28

$ok= ! MoveFileEx( "ReadOnly.txt", "CanWrite.txt", 0 )
 &&  Win32API::File::_fileLastError() == 183; # file already exists
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 29

$ok= CopyFile( "ReadOnly.txt", "ReadOnly.cp", 1 )
 &&  CopyFile( "CanWrite.txt", "CanWrite.cp", 1 );
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 30

$ok= ! MoveFileEx( "CanWrite.txt", "ReadOnly.cp", MOVEFILE_REPLACE_EXISTING )
 &&  (Win32API::File::_fileLastError() == 5     # access is denied
 ||   Win32API::File::_fileLastError() == 183); # already exists
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 31

$ok= MoveFileEx( "ReadOnly.cp", "CanWrite.cp", MOVEFILE_REPLACE_EXISTING );
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 32

$ok= MoveFile( "CanWrite.cp", "Moved.cp" );
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 33

$ok= ! unlink( "ReadOnly.cp" )
 &&  $! =~ /no such file/i
 &&  ! unlink( "CanWrite.cp" )
 &&  $! =~ /no such file/i;
$ok or print "# $!\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 34

$ok= ! DeleteFile( "Moved.cp" )
 &&  Win32API::File::_fileLastError() == 5; # access is denied
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 35

if ($^O eq 'cygwin') {
    chmod( 0200 | 07777 & (stat("Moved.cp"))[2], "Moved.cp" );
}
else {
    system( "attrib -r Moved.cp" );
}

$ok= DeleteFile( "Moved.cp" );
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 36

$new= SEM_FAILCRITICALERRORS|SEM_NOOPENFILEERRORBOX;
$old= SetErrorMode( $new );
$renew= SetErrorMode( $old );
$reold= SetErrorMode( $old );

$ok= $old == $reold;
$ok or print "# $old != $reold: ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 37

$ok= ($renew&$new) == $new;
$ok or print "# $new != $renew: ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 38

$ok= @drives= getLogicalDrives();
$ok && print "# @drives\n";
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 39

$ok=  $drives[0] !~ /^[ab]/  ||  DRIVE_REMOVABLE == GetDriveType($drives[0]);
$ok or print "# ",DRIVE_REMOVABLE," != ",GetDriveType($drives[0]),
  ": ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 40

$drive= substr( $ENV{WINDIR}, 0, 3 );

$ok= 1 == grep /^\Q$drive\E/i, @drives;
$ok or print "# No $drive found in list of drives.\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 41

$ok= DRIVE_FIXED == GetDriveType( $drive );
$ok or print
  "# ",DRIVE_FIXED," != ",GetDriveType($drive),": ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 42

$ok=  GetVolumeInformation( $drive, $vol, 64, $ser, $max, $flag, $fs, 16 );
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 43
$vol= $ser= $max= $flag= $fs= "";	# Prevent warnings.

chop($drive);
$ok= QueryDosDevice( $drive, $dev, 80 );
$ok or print "# $drive: ",fileLastError(),"\n";
if( $ok ) {
    ( $text= $dev ) =~ s/\0/\\0/g;
    print "# $drive => $text\n";
}
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 44

$bits= GetLogicalDrives();
$let= 25;
$bit= 1<<$let;
while(  $bit & $bits  ) {
    $let--;
    $bit >>= 1;
}
$let= pack( "C", $let + unpack("C","A") ) . ":";
print "# Querying undefined $let.\n";

$ok= DefineDosDevice( 0, $let, $ENV{WINDIR} );
$ok or print "# $let,$ENV{WINDIR}: ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 45

$ok=  -s $let."/Win.ini"  ==  -s $ENV{WINDIR}."/Win.ini";
$ok or print "# ", -s $let."/Win.ini", " vs. ",
  -s $ENV{WINDIR}."/Win.ini", ": ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 46

$ok= DefineDosDevice( DDD_REMOVE_DEFINITION|DDD_EXACT_MATCH_ON_REMOVE,
		      $let, $ENV{WINDIR} );
$ok or print "# $let,$ENV{WINDIR}: ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 47

$ok= ! -f $let."/Win.ini"
  &&  $! =~ /no such file/i;
$ok or print "# $!\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 48

$ok= DefineDosDevice( DDD_RAW_TARGET_PATH, $let, $dev );
if( !$ok  ) {
    ( $text= $dev ) =~ s/\0/\\0/g;
    print "# $let,$text: ",fileLastError(),"\n";
}
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 49

$ok= -f $let.substr($ENV{WINDIR},3)."/win.ini";
$ok or print "# ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 50

$ok= DefineDosDevice( DDD_REMOVE_DEFINITION|DDD_EXACT_MATCH_ON_REMOVE
		     |DDD_RAW_TARGET_PATH, $let, $dev );
$ok or print "# $let,$dev: ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 51

my $path = $ENV{WINDIR};
my $attrs = GetFileAttributes( $path );
$ok= $attrs != INVALID_FILE_ATTRIBUTES;
$ok or print "# $path gave invalid attribute value, attrs=$attrs: ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 52

$ok= ($attrs & FILE_ATTRIBUTE_DIRECTORY);
$ok or print "# $path not a directory, attrs=$attrs: ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 53

$path .= "/win.ini";
$attrs = GetFileAttributes( $path );
$ok= $attrs != INVALID_FILE_ATTRIBUTES;
$ok or print "# $path gave invalid attribute value, attrs=$attrs: ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 54

$ok= !($attrs & FILE_ATTRIBUTE_DIRECTORY);
$ok or print "# $path is a directory, attrs=$attrs: ",fileLastError(),"\n";
print $ok ? "" : "not ", "ok ", ++$test, "\n";	# ok 55

#	DefineDosDevice
#	GetFileType
#	GetVolumeInformation
#	QueryDosDevice
#Add a drive letter that points to our temp directory
#Add a drive letter that points to the drive our directory is in

#winnt.t:
# get first drive letters and use to test disk and storage IOCTLs
# "//./PhysicalDrive0"
#	DeviceIoControl

my %consts;
my @consts= @Win32API::File::EXPORT_OK;
@consts{@consts}= @consts;

my( @noargs, %noargs )= qw(
  attrLetsToBits fileLastError getLogicalDrives GetLogicalDrives );
@noargs{@noargs}= @noargs;

foreach $func ( @{$Win32API::File::EXPORT_TAGS{Func}} ) {
    delete $consts{$func};
    if(  defined( $noargs{$func} )  ) {
	$ok=  ! eval("$func(0,0)")  &&  $@ =~ /(::|\s)_?${func}A?[(:\s]/;
    } else {
	$ok=  ! eval("$func()")  &&  $@ =~ /(::|\s)_?${func}A?[(:\s]/;
    }
    $ok or print "# $func: $@\n";
    print $ok ? "" : "not ", "ok ", ++$test, "\n";
}

foreach $func ( @{$Win32API::File::EXPORT_TAGS{FuncA}},
                @{$Win32API::File::EXPORT_TAGS{FuncW}} ) {
    $ok=  ! eval("$func()")  &&  $@ =~ /::_?${func}\(/;
    delete $consts{$func};
    $ok or print "# $func: $@\n";
    print $ok ? "" : "not ", "ok ", ++$test, "\n";
}

foreach $const ( keys(%consts) ) {
    $ok= eval("my \$x= $const(); 1");
    $ok or print "# Constant $const: $@\n";
    print $ok ? "" : "not ", "ok ", ++$test, "\n";
}

chdir( $temp );
if (-e "$dir/ReadOnly.txt") {
    chmod 0777, "$dir/ReadOnly.txt";
    unlink "$dir/ReadOnly.txt";
}
unlink "$dir/CanWrite.txt" if -e "$dir/CanWrite.txt";
rmdir $dir;

__END__
Commit	Line	Data
00701878	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	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	}
00701878	21	END {print "not ok 1\n" unless $loaded;}
cf2f24a4	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.
de75d004	26
3826db83	27	require Win32 unless defined &Win32::FormatMessage;
de75d004	28	use File::Spec;
5a272364	29	use Carp;
5a272364	30	use Carp::Heavy;
cf2f24a4	31
00701878	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
de75d004	42	$temp= File::Spec->tmpdir();
00701878	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";
de75d004	49	$tempdir = File::Spec->catdir($temp,$dir);
00701878	50	if( -d $dir ) {
de75d004	51	print "# deleting ",File::Spec->catdir($temp,$dir,''),"\n" if glob "$dir/";
00701878	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 )
de75d004	60	or die "# Can't create temp dir, $tempdir: $!\n";
de75d004	61	print "# chdir $tempdir\n";
00701878	62	chdir( $dir )
de75d004	63	or die "# Can't cd to my dir, $tempdir: $!\n";
00701878	64	$h1= createFile( "ReadOnly.txt", "r", { Attributes=>"r" } );
de75d004	65	$ok= ! $h1 && Win32API::File::_fileLastError() == 2; # could not find the file
00701878	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" );
de75d004	79	$ok= ! $h2 && Win32API::File::_fileLastError() == 80; # file exists
00701878	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" );
de75d004	85	$ok= ! $h2 && Win32API::File::_fileLastError() == 5; # access is denied
00701878	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, [] )
de75d004	122	&& Win32API::File::_fileLastError() == 6; # handle is invalid
00701878	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");
de75d004	175	$ok = -e "CanWrite.txt" && $! =~ /permission denied/i;
00701878	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" )
de75d004	185	&& Win32API::File::_fileLastError() == 5; # access is denied
00701878	186	$ok or print "# ",fileLastError(),"\n";
	187	print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 23
	188
	189	$ok= ! CopyFile( "ReadOnly.txt", "CanWrite.txt", 1 )
de75d004	190	&& Win32API::File::_fileLastError() == 80; # file exists
00701878	191	$ok or print "# ",fileLastError(),"\n";
	192	print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 24
	193
	194	$ok= ! CopyFile( "CanWrite.txt", "ReadOnly.txt", 0 )
de75d004	195	&& Win32API::File::_fileLastError() == 5; # access is denied
00701878	196	$ok or print "# ",fileLastError(),"\n";
	197	print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 25
	198
	199	$ok= ! MoveFile( "NoSuchFile", "NoSuchDest" )
de75d004	200	&& Win32API::File::_fileLastError() == 2; # not find the file
00701878	201	$ok or print "# ",fileLastError(),"\n";
	202	print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 26
	203
	204	$ok= ! MoveFileEx( "NoSuchFile", "NoSuchDest", 0 )
de75d004	205	&& Win32API::File::_fileLastError() == 2; # not find the file
00701878	206	$ok or print "# ",fileLastError(),"\n";
	207	print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 27
	208
	209	$ok= ! MoveFile( "ReadOnly.txt", "CanWrite.txt" )
de75d004	210	&& Win32API::File::_fileLastError() == 183; # file already exists
00701878	211	$ok or print "# ",fileLastError(),"\n";
	212	print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 28
	213
	214	$ok= ! MoveFileEx( "ReadOnly.txt", "CanWrite.txt", 0 )
de75d004	215	&& Win32API::File::_fileLastError() == 183; # file already exists
00701878	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 )
cbd94dce	225	&& (Win32API::File::_fileLastError() == 5 # access is denied
cbd94dce	226	\|\| Win32API::File::_fileLastError() == 183); # already exists
00701878	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" )
de75d004	246	&& Win32API::File::_fileLastError() == 5; # access is denied
00701878	247	$ok or print "# ",fileLastError(),"\n";
	248	print $ok ? "" : "not ", "ok ", ++$test, "\n"; # ok 35
	249
78ff2d7b	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	}
00701878	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__