From 04c160e5073bcd7daf5c7a6f1754242d22e88cab Mon Sep 17 00:00:00 2001
From: Patrik Stridvall <ps@leissner.se>
Date: Tue, 15 Jan 2002 20:44:32 +0000
Subject: [PATCH] Added the possibility (it is optional for backward
 compability) to specify argument types in order to fix a "bug" concerning
 integer/string scalars.

---
 programs/winetest/include/wine.pm | 64 +++++++++++++++++++++++++------
 1 file changed, 53 insertions(+), 11 deletions(-)

diff --git a/programs/winetest/include/wine.pm b/programs/winetest/include/wine.pm
index ddb73e750db..0ff438a1c40 100644
--- a/programs/winetest/include/wine.pm
+++ b/programs/winetest/include/wine.pm
@@ -57,7 +57,12 @@ $todo_failures = 0;
 # |         access to them.  But I haven't worked it out       |
 # |         yet ...                                            |
 # --------------------------------------------------------------
-%return_types = ( "void" => 0, "int" => 1, "word" => 2, "ptr" => 3 );
+%return_types = ( 
+    "void" => 0,
+    "int" => 1, "long" => 1,
+    "word" => 2,
+    "ptr" => 3, "str" => 3, "wstr" => 3
+);
 
 
 # ------------------------------------------------------------------------
@@ -118,7 +123,7 @@ sub AUTOLOAD
 sub call($@)
 {
     my ($function,@args) = @_;
-    my ($funcptr,$ret_type) = @{$prototypes{$function}};
+    my ($funcptr,$ret_type,$arg_types) = @{$prototypes{$function}};
 
     if ($wine::debug > 1)
     {
@@ -131,9 +136,31 @@ sub call($@)
         print STDERR ")\n";
     }
 
+    # Check and translate args before call
+    my @args2;
+    if (defined($arg_types)) {
+	my @arg_types = @$arg_types;
+
+	if($#args != $#arg_types) {
+	    print STDERR "$function: too many arguments, expected " .
+		($#arg_types + 1) . ", got " . ($#args + 1) . "\n";
+	}
+
+	while (defined(my $arg = shift @args) &&
+               defined(my $arg_type = shift @arg_types))
+        {
+	    if($arg_type == 1 || $arg_type == 2) { # int || word
+		$arg = int($arg);
+	    }
+	    push @args2, $arg;
+	}
+    } else {
+	@args2 = @args;
+    }
+
     # Now call call_wine_API(), which will turn around and call
     # the appropriate wine API function.
-    my ($err,$r) = call_wine_API( $funcptr, $ret_type, $wine::debug-1, @args );
+    my ($err,$r) = call_wine_API( $funcptr, $ret_type, $wine::debug-1, @args2 );
 
     if ($wine::debug > 1)
     {
@@ -170,8 +197,19 @@ sub declare($%)
     foreach $func (keys %list)
     {
         my $ptr = get_proc_address( $handle, $func ) or die "Could not find '$func' in '$module'";
-        my $ret_type = $return_types{$list{$func}};
-        $prototypes{$func} = [ $ptr, $ret_type ];
+
+	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 ];
+	} else {
+	    my $ret_type = $return_types{$list{$func}};
+
+	    $prototypes{$func} = [ $ptr, $ret_type ];
+	}
     }
 }
 
@@ -526,8 +564,8 @@ wine - Perl extension for calling wine API functions
     use wine;
 
     wine::declare( "kernel32",
-                   SetLastError => "void",
-                   GetLastError => "int" );
+                   SetLastError => ["void", ["int"]],
+                   GetLastError => ["int", []] );
     SetLastError( 1234 );
     printf "%d\n", GetLastError();
 
@@ -542,11 +580,11 @@ a Perl script.
 The functions you want to call must first be declared by calling
 the wine::declare method. The first argument is the name of the
 module containing the APIs, and the next argument is a list of
-function names and their return types. For instance:
+function names and their return and argument types. For instance:
 
     wine::declare( "kernel32",
-                   SetLastError => "void",
-                   GetLastError => "int" );
+                   SetLastError => ["void", ["int"]],
+                   GetLastError => ["int", []] );
 
 declares that the functions SetLastError and GetLastError are
 contained in the kernel32 dll.
@@ -564,10 +602,14 @@ The supported return types are:
 
 =item word
 
-=item int
+=item long
 
 =item ptr
 
+=item str
+
+=item wstr
+
 =back
 
 =head1 $wine::err VARIABLE
-- 
GitLab