ReceiveTempSMS
/
Sweden-Number
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Don't convert "ptr" return type to a Perl string. 

Call GetProcAddress only when a function is actually called, not at
declaration time.
This commit is contained in:
Alexandre Julliard 2002-01-21 17:41:52 +00:00
parent 45342a35fe
commit 6ca0ba2a73
3 changed files with 27 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
programs/winetest/include/wine.pm
View File

@ -61,7 +61,8 @@ $todo_failures = 0;
"void" => 0,
"int" => 1, "long" => 1,
"word" => 2,
"ptr" => 3, "str" => 3, "wstr" => 3
"ptr" => 3,
"str" => 4, "wstr" => 4
);
@ -123,7 +124,14 @@ sub AUTOLOAD
sub call($@)
{
my ($function,@args) = @_;
my ($funcptr,$ret_type,$arg_types) = @{$prototypes{$function}};
my ($module,$funcptr,$ret_type,$arg_types) = @{$prototypes{$function}};
unless ($funcptr)
{
my $handle = $loaded_modules{$module};
$funcptr = get_proc_address( $handle, $function ) or die "Could not get address for $module.$function";
${$prototypes{$function}}[1] = $funcptr;
}
if ($wine::debug > 1)
{
@ -142,7 +150,7 @@ sub call($@)
my @arg_types = @$arg_types;
if($#args != $#arg_types) {
print STDERR "$function: too many arguments, expected " .
die "$function: Wrong number of arguments, expected " .
($#arg_types + 1) . ", got " . ($#args + 1) . "\n";
}
@ -196,19 +204,17 @@ sub declare($%)
foreach $func (keys %list)
{
my $ptr = get_proc_address( $handle, $func ) or die "Could not find '$func' in '$module'";
if(ref($list{$func}) eq "ARRAY") {
my ($return_type, $argument_types) = @{$list{$func}};
my $ret_type = $return_types{$return_type};
my $arg_types = [map { $return_types{$_} } @$argument_types];
$prototypes{$func} = [ $ptr, $ret_type, $arg_types ];
$prototypes{$func} = [ $module, 0, $ret_type, $arg_types ];
} else {
my $ret_type = $return_types{$list{$func}};
$prototypes{$func} = [ $ptr, $ret_type ];
$prototypes{$func} = [ $module, 0, $ret_type ];
}
}
}

25
programs/winetest/tests/wine.pl
View File

@ -4,20 +4,7 @@
use wine;
################################################################
# Declarations for functions we use in this script
wine::declare( "kernel32",
SetLastError => "void",
GetLastError => ["int", []],
GlobalAddAtomA => ["word",["str"]],
GlobalGetAtomNameA => ["int", ["int","ptr","int"]],
GetCurrentThread => ["int", []],
GetExitCodeThread => ["int", ["int","ptr"]],
GetModuleHandleA => ["int", ["str"]],
GetProcAddress => ["int", ["long","str"]],
lstrcatA => ["str", ["str","str"]],
);
use kernel32;
################################################################
# Test some simple function calls
@ -56,8 +43,16 @@ ok( $ret == 123 );
################################################################
# Test various error cases
eval { SetLastError(1,2); };
ok( $@ =~ /Wrong number of arguments, expected 1, got 2/ );
wine::declare("kernel32", "SetLastError" => "int" ); # disable prototype
eval { SetLastError(1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,6,7); };
ok( $@ =~ /Too many arguments at/ );
ok( $@ =~ /Too many arguments/ );
wine::declare("kernel32", "non_existent_func" => ["int",["int"]]);
eval { non_existent_func(1); };
ok( $@ =~ /Could not get address for kernel32\.non_existent_func/ );
my $funcptr = GetProcAddress( GetModuleHandleA("kernel32"), "SetLastError" );
ok( $funcptr );

6
programs/winetest/wine.xs
View File

@ -24,7 +24,8 @@ enum ret_type
RET_VOID = 0,
RET_INT = 1,
RET_WORD = 2,
RET_PTR = 3
RET_PTR = 3,
RET_STR = 4
};
/* max arguments for a function call */
@ -121,7 +122,8 @@ static SV *convert_value( enum ret_type type, unsigned long val )
case RET_VOID: return &PL_sv_undef;
case RET_INT: return sv_2mortal( newSViv ((int) val ));
case RET_WORD: return sv_2mortal( newSViv ((int) val & 0xffff ));
case RET_PTR: return sv_2mortal( newSVpv ((char *) val, 0 ));
case RET_PTR: return sv_2mortal( newSViv ((int) val ));
case RET_STR: return sv_2mortal( newSVpv ((char *) val, 0 ));
default:
croak ("Bad return type %d", type);