| Subject: | returned numbers are always signed, ignoring prototype |
The return values, if they are integers (I didnt test any other return
values), of the Call method are always signed. This means Call is
ignoring the ULONG/LONG signed/unsignedness of the return type. There
are no code paths in the XS code to return UVs. Everything is an IV.
Adding "$ret = unpack('L',pack('l',$ret));" to the badsign.pl test
script fixes the problem. But its still a bug in Win32::API. Any use of
C constants or C constant subs in Perl and comparing the return of a
Call to them is impossible because of this bug. All the signedness is
lost in sub type_to_num. The T_ constants in XS have no signedness.
Show quoted text
______________________________________________________
C:\Documents and Settings\Owner\Desktop\w32api>perl badsign.pl
Win32::API 0.68
Win32::API::new: Loading library 'testdll.dll'
(PM)parse_prototype: got PROC '_DWORDCall@0'
(PM)parse_prototype: got PARAMS ''
parse_prototype: IN=[ ]
parse_prototype: OUT='DWORD' PACKING='L' API_TYPE=1
GetProcAddress('_DWORDCall@0') = '3801680'
Object blessed!
return (val=-2147483648) should be equal to CONST (val=2147483648) but
isnt at b
adsign.pl line 14.
Win32::API::DESTROY: Freeing library 'testdll.dll'
C:\Documents and Settings\Owner\Desktop\w32api>
_________________________________________________________
| Subject: | testdll.c |
#include <windows.h>
BOOL APIENTRY _DllMainCRTStartup (HINSTANCE hinstDLL, DWORD fdwReason, LPVOID lpReserved )
{
return TRUE;
}
__declspec( dllexport ) DWORD __stdcall PtrUShortCall (DWORD_PTR ptr, USHORT num){
return 1;
}
__declspec( dllexport ) DWORD __stdcall DWORDCall(){
return 0x80000000;
}
| Subject: | compile.bat |
Message body not shown because it is not plain text.
| Subject: | badsign.pl |
#!/usr/bin/perl -w
#use strict;
BEGIN {
sub CONST () { 0x80000000 }
}
use Win32::API;
$| = 1;
$Win32::API::DEBUG = 1;
print "Win32::API $Win32::API::VERSION\n";
my $o = Win32::API->new( 'testdll.dll',
'DWORD __stdcall _DWORDCall@0()'
);
my $ret = $o->Call();
die "return (val=$ret) should be equal to CONST (val=".CONST.") but isnt"
if $ret != CONST;
print "exiting\n";