Skip to content
Projects
Groups
Snippets
Help
This project
Loading...
Sign in / Register
Toggle navigation
W
wine-winehq
Project
Project
Details
Activity
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Registry
Registry
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
wine
wine-winehq
Commits
6ca0ba2a
Commit
6ca0ba2a
authored
Jan 21, 2002
by
Alexandre Julliard
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
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
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
27 additions
and
24 deletions
+27
-24
wine.pm
programs/winetest/include/wine.pm
+13
-7
wine.pl
programs/winetest/tests/wine.pl
+10
-15
wine.xs
programs/winetest/wine.xs
+4
-2
No files found.
programs/winetest/include/wine.pm
View file @
6ca0ba2a
...
...
@@ -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
];
}
}
}
...
...
programs/winetest/tests/wine.pl
View file @
6ca0ba2a
...
...
@@ -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
);
...
...
programs/winetest/wine.xs
View file @
6ca0ba2a
...
...
@@ -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);
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment