Commit 6ca0ba2a authored by Alexandre Julliard's avatar Alexandre Julliard

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

Call GetProcAddress only when a function is actually called, not at declaration time.
parent 45342a35
...@@ -61,7 +61,8 @@ $todo_failures = 0; ...@@ -61,7 +61,8 @@ $todo_failures = 0;
"void" => 0, "void" => 0,
"int" => 1, "long" => 1, "int" => 1, "long" => 1,
"word" => 2, "word" => 2,
"ptr" => 3, "str" => 3, "wstr" => 3 "ptr" => 3,
"str" => 4, "wstr" => 4
); );
...@@ -123,7 +124,14 @@ sub AUTOLOAD ...@@ -123,7 +124,14 @@ sub AUTOLOAD
sub call($@) sub call($@)
{ {
my ($function,@args) = @_; 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) if ($wine::debug > 1)
{ {
...@@ -142,7 +150,7 @@ sub call($@) ...@@ -142,7 +150,7 @@ sub call($@)
my @arg_types = @$arg_types; my @arg_types = @$arg_types;
if($#args != $#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"; ($#arg_types + 1) . ", got " . ($#args + 1) . "\n";
} }
...@@ -196,19 +204,17 @@ sub declare($%) ...@@ -196,19 +204,17 @@ sub declare($%)
foreach $func (keys %list) 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") { if(ref($list{$func}) eq "ARRAY") {
my ($return_type, $argument_types) = @{$list{$func}}; my ($return_type, $argument_types) = @{$list{$func}};
my $ret_type = $return_types{$return_type}; my $ret_type = $return_types{$return_type};
my $arg_types = [map { $return_types{$_} } @$argument_types]; my $arg_types = [map { $return_types{$_} } @$argument_types];
$prototypes{$func} = [ $ptr, $ret_type, $arg_types ]; $prototypes{$func} = [ $module, 0, $ret_type, $arg_types ];
} else { } else {
my $ret_type = $return_types{$list{$func}}; my $ret_type = $return_types{$list{$func}};
$prototypes{$func} = [ $ptr, $ret_type ]; $prototypes{$func} = [ $module, 0, $ret_type ];
} }
} }
} }
......
...@@ -4,20 +4,7 @@ ...@@ -4,20 +4,7 @@
use wine; use wine;
################################################################ use kernel32;
# 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"]],
);
################################################################ ################################################################
# Test some simple function calls # Test some simple function calls
...@@ -56,8 +43,16 @@ ok( $ret == 123 ); ...@@ -56,8 +43,16 @@ ok( $ret == 123 );
################################################################ ################################################################
# Test various error cases # 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); }; 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" ); my $funcptr = GetProcAddress( GetModuleHandleA("kernel32"), "SetLastError" );
ok( $funcptr ); ok( $funcptr );
......
...@@ -24,7 +24,8 @@ enum ret_type ...@@ -24,7 +24,8 @@ enum ret_type
RET_VOID = 0, RET_VOID = 0,
RET_INT = 1, RET_INT = 1,
RET_WORD = 2, RET_WORD = 2,
RET_PTR = 3 RET_PTR = 3,
RET_STR = 4
}; };
/* max arguments for a function call */ /* max arguments for a function call */
...@@ -121,7 +122,8 @@ static SV *convert_value( enum ret_type type, unsigned long val ) ...@@ -121,7 +122,8 @@ static SV *convert_value( enum ret_type type, unsigned long val )
case RET_VOID: return &PL_sv_undef; case RET_VOID: return &PL_sv_undef;
case RET_INT: return sv_2mortal( newSViv ((int) val )); case RET_INT: return sv_2mortal( newSViv ((int) val ));
case RET_WORD: return sv_2mortal( newSViv ((int) val & 0xffff )); 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: default:
croak ("Bad return type %d", type); croak ("Bad return type %d", type);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment