From 6ca0ba2a7349ea3d67b52de1897134edc59ead21 Mon Sep 17 00:00:00 2001
From: Alexandre Julliard <julliard@winehq.org>
Date: Mon, 21 Jan 2002 17:41:52 +0000
Subject: [PATCH] Don't convert "ptr" return type to a Perl string. Call
 GetProcAddress only when a function is actually called, not at declaration
 time.

---
 programs/winetest/include/wine.pm | 20 +++++++++++++-------
 programs/winetest/tests/wine.pl   | 25 ++++++++++---------------
 programs/winetest/wine.xs         |  6 ++++--
 3 files changed, 27 insertions(+), 24 deletions(-)

diff --git a/programs/winetest/include/wine.pm b/programs/winetest/include/wine.pm
index 0ff438a1c40..305828b58c9 100644
--- a/programs/winetest/include/wine.pm
+++ b/programs/winetest/include/wine.pm
@@ -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 ];
 	}
     }
 }
diff --git a/programs/winetest/tests/wine.pl b/programs/winetest/tests/wine.pl
index a4dd6ab438b..41b6b0c27fa 100644
--- a/programs/winetest/tests/wine.pl
+++ b/programs/winetest/tests/wine.pl
@@ -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 );
diff --git a/programs/winetest/wine.xs b/programs/winetest/wine.xs
index 3b271264de9..414174291b9 100644
--- a/programs/winetest/wine.xs
+++ b/programs/winetest/wine.xs
@@ -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);