#!/usr/bin/perl -w
BEGIN { $|= 1;
print
"1..267\n"
; }
END {
print
"not ok 1\n"
unless
$loaded
;}
$loaded
= 1;
print
"ok 1\n"
;
$test
= 1;
$temp
=
$ENV
{
"TMP"
};
$temp
=
$ENV
{
"TEMP"
}
unless
-d
$temp
;
$temp
=
"C:/Temp"
unless
-d
$temp
;
$temp
=
"."
unless
-d
$temp
;
$dir
=
"W32ApiF.tmp"
;
$ENV
{WINDIR} =
$ENV
{SYSTEMROOT}
if
not
exists
$ENV
{WINDIR};
chdir
(
$temp
)
or
die
"# Can't cd to temp directory, $temp: $!\n"
;
if
( -d
$dir
) {
print
"# deleting $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, $temp/$dir: $!\n"
;
print
"# chdir $temp\\$dir\n"
;
chdir
(
$dir
)
or
die
"# Can't cd to my dir, $temp/$dir: $!\n"
;
$h1
= createFile(
"ReadOnly.txt"
,
"r"
, {
Attributes
=>
"r"
} );
$ok
= !
$h1
&& fileLastError() =~ /not find the file?/i;
$ok
or
print
"# "
,
""
.fileLastError(),
"\n"
;
print
$ok
?
""
:
"not "
,
"ok "
, ++
$test
,
"\n"
;
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
= WriteFile(
$h1
,
"Original text\n"
, 0, [], [] );
$ok
or
print
"# "
,fileLastError(),
"\n"
;
print
$ok
?
""
:
"not "
,
"ok "
, ++
$test
,
"\n"
;
$h2
= createFile(
"ReadOnly.txt"
,
"rcn"
);
$ok
= !
$h2
&& fileLastError() =~ /file
exists
?/i;
$ok
or
print
"# "
,fileLastError(),
"\n"
;
print
$ok
?
""
:
"not "
,
"ok "
, ++
$test
,
"\n"
;
if
( !
$ok
) { CloseHandle(
$h2
); }
$h2
= createFile(
"ReadOnly.txt"
,
"rwke"
);
$ok
= !
$h2
&& fileLastError() =~ /access is denied?/i;
$ok
or
print
"# "
,fileLastError(),
"\n"
;
print
$ok
?
""
:
"not "
,
"ok "
, ++
$test
,
"\n"
;
if
( !
$ok
) { CloseHandle(
$h2
); }
$ok
=
$h2
= createFile(
"ReadOnly.txt"
,
"r"
);
$ok
or
print
"# "
,fileLastError(),
"\n"
;
print
$ok
?
""
:
"not "
,
"ok "
, ++
$test
,
"\n"
;
$ok
= SetFilePointer(
$h1
,
length
(
"Original"
), [], FILE_BEGIN );
$ok
or
print
"# "
,fileLastError(),
"\n"
;
print
$ok
?
""
:
"not "
,
"ok "
, ++
$test
,
"\n"
;
$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
= 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
=
$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
= CloseHandle(
$h2
);
$ok
or
print
"# "
,fileLastError(),
"\n"
;
print
$ok
?
""
:
"not "
,
"ok "
, ++
$test
,
"\n"
;
$ok
= ! ReadFile(
$h2
,
$text
, 80,
$len
, [] )
&& fileLastError() =~ /handle is invalid?/i;
$ok
or
print
"# "
,fileLastError(),
"\n"
;
print
$ok
?
""
:
"not "
,
"ok "
, ++
$test
,
"\n"
;
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
= WriteFile(
$h1
,
"Just this and not this"
, 10, [], [] );
$ok
or
print
"# "
,fileLastError(),
"\n"
;
print
$ok
?
""
:
"not "
,
"ok "
, ++
$test
,
"\n"
;
$ok
=
$h2
= createFile(
"CanWrite.txt"
,
"wk"
, {
Share
=>
"rw"
} );
$ok
or
print
"# "
,fileLastError(),
"\n"
;
print
$ok
?
""
:
"not "
,
"ok "
, ++
$test
,
"\n"
;
$ok
= OsFHandleOpen(
"APP"
,
$h2
,
"wat"
);
$ok
or
print
"# "
,fileLastError(),
"\n"
;
print
$ok
?
""
:
"not "
,
"ok "
, ++
$test
,
"\n"
;
$ok
=
$h2
== GetOsFHandle(
"APP"
);
$ok
or
print
"# $h2 != "
,GetOsFHandle(
"APP"
),
"\n"
;
print
$ok
?
""
:
"not "
,
"ok "
, ++
$test
,
"\n"
;
{
my
$save
=
select
(APP); $|= 1;
select
(
$save
); }
$ok
=
print
APP
"is enough\n"
;
$ok
or
print
"# "
,fileLastError(),
"\n"
;
print
$ok
?
""
:
"not "
,
"ok "
, ++
$test
,
"\n"
;
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
=
$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"
;
$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"
;
close
(APP);
CloseHandle(
$h1
);
$ok
= ! DeleteFile(
"ReadOnly.txt"
)
&& fileLastError() =~ /access is denied?/i;
$ok
or
print
"# "
,fileLastError(),
"\n"
;
print
$ok
?
""
:
"not "
,
"ok "
, ++
$test
,
"\n"
;
$ok
= ! CopyFile(
"ReadOnly.txt"
,
"CanWrite.txt"
, 1 )
&& fileLastError() =~ /file
exists
?/i;
$ok
or
print
"# "
,fileLastError(),
"\n"
;
print
$ok
?
""
:
"not "
,
"ok "
, ++
$test
,
"\n"
;
$ok
= ! CopyFile(
"CanWrite.txt"
,
"ReadOnly.txt"
, 0 )
&& fileLastError() =~ /access is denied?/i;
$ok
or
print
"# "
,fileLastError(),
"\n"
;
print
$ok
?
""
:
"not "
,
"ok "
, ++
$test
,
"\n"
;
$ok
= ! MoveFile(
"NoSuchFile"
,
"NoSuchDest"
)
&& fileLastError() =~ /not find the file/i;
$ok
or
print
"# "
,fileLastError(),
"\n"
;
print
$ok
?
""
:
"not "
,
"ok "
, ++
$test
,
"\n"
;
$ok
= ! MoveFileEx(
"NoSuchFile"
,
"NoSuchDest"
, 0 )
&& fileLastError() =~ /not find the file/i;
$ok
or
print
"# "
,fileLastError(),
"\n"
;
print
$ok
?
""
:
"not "
,
"ok "
, ++
$test
,
"\n"
;
$ok
= ! MoveFile(
"ReadOnly.txt"
,
"CanWrite.txt"
)
&& fileLastError() =~ /file already
exists
?/i;
$ok
or
print
"# "
,fileLastError(),
"\n"
;
print
$ok
?
""
:
"not "
,
"ok "
, ++
$test
,
"\n"
;
$ok
= ! MoveFileEx(
"ReadOnly.txt"
,
"CanWrite.txt"
, 0 )
&& fileLastError() =~ /file already
exists
?/i;
$ok
or
print
"# "
,fileLastError(),
"\n"
;
print
$ok
?
""
:
"not "
,
"ok "
, ++
$test
,
"\n"
;
$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
= ! MoveFileEx(
"CanWrite.txt"
,
"ReadOnly.cp"
, MOVEFILE_REPLACE_EXISTING )
&& fileLastError() =~ /access is denied?|cannot create/i;
$ok
or
print
"# "
,fileLastError(),
"\n"
;
print
$ok
?
""
:
"not "
,
"ok "
, ++
$test
,
"\n"
;
$ok
= MoveFileEx(
"ReadOnly.cp"
,
"CanWrite.cp"
, MOVEFILE_REPLACE_EXISTING );
$ok
or
print
"# "
,fileLastError(),
"\n"
;
print
$ok
?
""
:
"not "
,
"ok "
, ++
$test
,
"\n"
;
$ok
= MoveFile(
"CanWrite.cp"
,
"Moved.cp"
);
$ok
or
print
"# "
,fileLastError(),
"\n"
;
print
$ok
?
""
:
"not "
,
"ok "
, ++
$test
,
"\n"
;
$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
= ! DeleteFile(
"Moved.cp"
)
&& fileLastError() =~ /access is denied?/i;
$ok
or
print
"# "
,fileLastError(),
"\n"
;
print
$ok
?
""
:
"not "
,
"ok "
, ++
$test
,
"\n"
;
system
(
"attrib -r Moved.cp"
);
$ok
= DeleteFile(
"Moved.cp"
);
$ok
or
print
"# "
,fileLastError(),
"\n"
;
print
$ok
?
""
:
"not "
,
"ok "
, ++
$test
,
"\n"
;
$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
= (
$renew
&$new
) ==
$new
;
$ok
or
print
"# $new != $renew: "
,fileLastError(),
"\n"
;
print
$ok
?
""
:
"not "
,
"ok "
, ++
$test
,
"\n"
;
$ok
=
@drives
= getLogicalDrives();
$ok
&&
print
"# @drives\n"
;
$ok
or
print
"# "
,fileLastError(),
"\n"
;
print
$ok
?
""
:
"not "
,
"ok "
, ++
$test
,
"\n"
;
$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"
;
$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
= DRIVE_FIXED == GetDriveType(
$drive
);
$ok
or
print
"# "
,DRIVE_FIXED,
" != "
,GetDriveType(
$drive
),
": "
,fileLastError(),
"\n"
;
print
$ok
?
""
:
"not "
,
"ok "
, ++
$test
,
"\n"
;
$ok
= GetVolumeInformation(
$drive
,
$vol
, 64,
$ser
,
$max
,
$flag
,
$fs
, 16 );
$ok
or
print
"# "
,fileLastError(),
"\n"
;
print
$ok
?
""
:
"not "
,
"ok "
, ++
$test
,
"\n"
;
$vol
=
$ser
=
$max
=
$flag
=
$fs
=
""
;
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"
;
$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
= -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
= 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
= ! -f
$let
.
"/Win.ini"
&& $! =~ /
no
such file/i;
$ok
or
print
"# $!\n"
;
print
$ok
?
""
:
"not "
,
"ok "
, ++
$test
,
"\n"
;
$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
= -f
$let
.
substr
(
$ENV
{WINDIR},3).
"/win.ini"
;
$ok
or
print
"# "
,fileLastError(),
"\n"
;
print
$ok
?
""
:
"not "
,
"ok "
, ++
$test
,
"\n"
;
$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"
;
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
= (
$attrs
& FILE_ATTRIBUTE_DIRECTORY);
$ok
or
print
"# $path not a directory, attrs=$attrs: "
,fileLastError(),
"\n"
;
print
$ok
?
""
:
"not "
,
"ok "
, ++
$test
,
"\n"
;
$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
= !(
$attrs
& FILE_ATTRIBUTE_DIRECTORY);
$ok
or
print
"# $path is a directory, attrs=$attrs: "
,fileLastError(),
"\n"
;
print
$ok
?
""
:
"not "
,
"ok "
, ++
$test
,
"\n"
;
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
;