From 43ee5176a7607c14658a7393409387f2d594bb36 Mon Sep 17 00:00:00 2001
From: Stephen Bennett <sbennett@accelrys.com>
Date: Fri, 9 Jul 2010 09:09:21 +0100
Subject: [PATCH 2/2] Add support for DWORD_PTR type in function arguments and structs

---
 API_test.dll                  |  Bin 68608 -> 69120 bytes
 API_test64.dll                |  Bin 71680 -> 72192 bytes
 Type.pm                       |   14 +++++++++++++-
 api-test/API_test.cpp         |    8 ++++++--
 api-test/API_test.h           |    1 +
 api-test/Release/API_test.dll |  Bin 68608 -> 69120 bytes
 api-test/Release/API_test.lib |  Bin 4912 -> 4912 bytes
 t/01_Struct.t                 |   21 +++++++++++++++++++--
 8 files changed, 39 insertions(+), 5 deletions(-)
 mode change 100644 => 100755 API_test.dll
 mode change 100644 => 100755 api-test/API_test.cpp
 mode change 100644 => 100755 api-test/Release/API_test.dll
 mode change 100644 => 100755 api-test/Release/API_test.lib

diff --git a/API_test.dll b/API_test.dll
old mode 100644
new mode 100755
index a45cec55418dfc9349445c880c2fced1a96315f7..1cb36c6bd44a3afd0fe35f34de76b27669396da3
GIT binary patch
diff --git a/API_test64.dll b/API_test64.dll
index e8cb055c8bd7e136c755d2918b41c0a6335a609c..4350019a814f30bcc1acbf7b94a012a7aea810bf 100755
GIT binary patch
diff --git a/Type.pm b/Type.pm
index da17a57..c0f5170 100644
--- a/Type.pm
+++ b/Type.pm
@@ -17,6 +17,7 @@ package Win32::API::Type;
 $VERSION = '0.60';
 
 use Carp;
+use Config;
 
 require Exporter;       # to export the constants to the main:: space
 require DynaLoader;     # to dynuhlode the module.
@@ -51,10 +52,16 @@ foreach (<DATA>) {
     if($section eq 'TYPE') {
         my($name, $packing) = split(/\s+/);
         # DEBUG "(PM)Type::INIT: Known('$name') => '$packing'\n";
+        if ($packing eq '_P') {
+            $packing = pointer_pack_type();
+        }
         $Known{$name} = $packing;
     } elsif($section eq 'PACKSIZE') {
         my($packing, $size) = split(/\s+/);
         # DEBUG "(PM)Type::INIT: PackSize('$packing') => '$size'\n";
+        if ($size eq '_P') {
+            $size = $Config{ptrsize};
+        }
         $PackSize{$packing} = $size;
     } elsif($section eq 'MODIFIER') {
         my($modifier, $mapto) = split(/\s+/, $_, 2);
@@ -108,6 +115,10 @@ sub is_known {
     }
 }
 
+sub pointer_pack_type {
+    return $Config{ptrsize} == 8 ? 'Q' : 'L';
+}
+
 sub sizeof {
     my $self = shift;
     my $type = shift;
@@ -297,6 +308,7 @@ COLORREF				L
 DWORD                   L
 DWORD32                 L
 DWORD64                 Q
+DWORD_PTR               _P
 FLOAT                   f
 HACCEL                  L
 HANDLE                  L
@@ -396,7 +408,7 @@ q   8
 Q   8
 s   2
 S   2
-p   4
+p   _P
 
 [MODIFIER]
 unsigned    int=I long=L short=S char=C
diff --git a/api-test/API_test.cpp b/api-test/API_test.cpp
old mode 100644
new mode 100755
index 8fd9248..c9c4fbc
--- a/api-test/API_test.cpp
+++ b/api-test/API_test.cpp
@@ -88,10 +88,11 @@ API_TEST_API void __stdcall dump_struct(const char *name, simple_struct *x) {
 	printf("dump_struct: [%s at 0x%08x] ", name, x);
 	printf("a=%d ", x->a);
 	printf("b=%f ", x->b);
-	printf("c=0x%08x ", x->c);
+	printf("c=0x%p ", x->c);
 	if(x->c != NULL) {
-		printf("'%s'", x->c);
+		printf("'%s' ", x->c);
 	}
+	printf("d=0x%p ", x->d);
 	printf("\n"); 
 
 }
@@ -104,12 +105,14 @@ API_TEST_API int __stdcall mangle_simple_struct(simple_struct *x) {
 	mine.a = 5;
 	mine.b = 2.5;
 	mine.c = NULL;
+	mine.d = 0x12345678;
 
 	dump_struct("mine", &mine);
 	dump_struct("yours", x);
 
 	x->a /= 2;
 	x->b *= 2;
+	x->d = ~x->d;
 
 /*	tmp = (char *) malloc(strlen(x->c)); */
 	tmp = x->c;
@@ -123,6 +126,7 @@ API_TEST_API int __stdcall mangle_simple_struct(simple_struct *x) {
 		tmp[0] = toupper(tmp[0]);
 		tmp++;
 	}
+	printf("x.d=0x%08x\n", x->d);
 	return 1;
 }
 
diff --git a/api-test/API_test.h b/api-test/API_test.h
index 30ff440..ca4cdb2 100644
--- a/api-test/API_test.h
+++ b/api-test/API_test.h
@@ -20,6 +20,7 @@ typedef struct _simple_struct {
 	int a;
 	double b;
 	char * c;
+	DWORD_PTR d;
 } simple_struct, LPsimple_struct;
 
 // typedef int callback_func(int);
diff --git a/api-test/Release/API_test.dll b/api-test/Release/API_test.dll
old mode 100644
new mode 100755
index a45cec55418dfc9349445c880c2fced1a96315f7..1cb36c6bd44a3afd0fe35f34de76b27669396da3
GIT binary patch
diff --git a/api-test/Release/API_test.lib b/api-test/Release/API_test.lib
old mode 100644
new mode 100755
index 227de0689f9e76464d4cdbac7579b593d10602bf..d6f43665b0762f163563062bee5ccf2cd8b82de0
GIT binary patch
diff --git a/t/01_Struct.t b/t/01_Struct.t
index 0f2cae8..45799c2 100644
--- a/t/01_Struct.t
+++ b/t/01_Struct.t
@@ -28,6 +28,7 @@ typedef Win32::API::Struct('simple_struct', qw(
 	int a;
 	double b;
 	LPSTR c;
+	DWORD_PTR d;
 ));
 
 my $simple_struct = Win32::API::Struct->new( 'simple_struct' );
@@ -37,6 +38,15 @@ $simple_struct->align('auto');
 $simple_struct->{a} = 5;
 $simple_struct->{b} = 2.5;
 $simple_struct->{c} = "test";
+$simple_struct->{d} = 0x12345678;
+
+my $mangled_d;
+
+if (Win32::API::Test::is_perl_64bit()) {
+    $mangled_d = 18446744073404131719; #0xffffffffedcba987; perl errors on hex constants that large, but for some reason not decimal ones
+} else {
+    $mangled_d = 0xedcba987;
+}
 
 $function = new Win32::API($test_dll, 'mangle_simple_struct', 'S', 'I');
 ok(defined($function), 'mangle_simple_struct() function');
@@ -44,10 +54,14 @@ diag('$^E=',$^E);
 
 $result = $function->Call( $simple_struct );
 
+#print "\n\n\na=$simple_struct->{a} b=$simple_struct->{b} c=$simple_struct->{c} d=$simple_struct->{d}\n\n\n";
+printf "\n\n\na=%s b=%s c=%s d=%08x\n\n\n", $simple_struct->{a}, $simple_struct->{b}, $simple_struct->{c}, $simple_struct->{d};
+
 ok(
 	$simple_struct->{a} == 2 &&
 	$simple_struct->{b} == 5 &&
-	$simple_struct->{c} eq 'TEST',
+	$simple_struct->{c} eq 'TEST' &&
+	$simple_struct->{d} eq $mangled_d,
 	'mangling of simple structures work'
 );
 
@@ -58,13 +72,16 @@ tied(%simple_struct)->align('auto');
 $simple_struct{a} = 5;
 $simple_struct{b} = 2.5;
 $simple_struct{c} = "test";
+$simple_struct{d} = $mangled_d;
 
+printf "\n\n\na=%s b=%s c=%s d=%08x\n\n\n", $simple_struct->{a}, $simple_struct->{b}, $simple_struct->{c}, $simple_struct->{d};
 $result = $function->Call( \%simple_struct );
 
 ok(
 	$simple_struct{a} == 2 &&
 	$simple_struct{b} == 5 &&
-	$simple_struct{c} eq 'TEST',
+	$simple_struct{c} eq 'TEST' &&
+	$simple_struct->{d} eq $mangled_d,
 	'tied interface works'
 );
 
-- 
1.7.1

