Skip to content

Commit 1e729b0

Browse files
author
pyscripter
committed
Added unit tests for callbacks with four and five arguments.
1 parent 5f165f7 commit 1e729b0

File tree

2 files changed

+37
-0
lines changed

2 files changed

+37
-0
lines changed

PythonForDelphi/Components/Sources/Core/UnitTests/MethodCallBackTest.pas

Lines changed: 37 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -24,14 +24,20 @@ interface
2424

2525
implementation
2626

27+
2728
type
29+
TFourArgStdFunction = function(arg1, arg2, arg3, arg4: integer): integer; stdcall;
30+
TFiveArgCdeclFunction = function(arg1, arg2, arg3, arg4, arg5: integer): integer; cdecl;
31+
2832
TTestObj = class(TObject)
2933
public
3034
Argument1: string;
3135
Argument2: string;
3236
Argument3: string;
3337
function TwoArgStdFunction(arg1: string; arg2: string): integer; stdcall;
3438
procedure ThreeArgCdeclProcedure(arg1: string; arg2: string; arg3: string); cdecl;
39+
function FourArgStdFunction(arg1, arg2, arg3, arg4: integer): integer; stdcall;
40+
function FiveArgCdeclFunction(arg1, arg2, arg3, arg4, arg5: integer): integer; cdecl;
3541
end;
3642

3743
TMethodCallbackTest = class(TTestCase)
@@ -46,6 +52,8 @@ TMethodCallbackTest = class(TTestCase)
4652
procedure TestOfObjectCallBackStdCall;
4753
procedure TestOfObjectCallBackCDecl;
4854
procedure TestDeleteCallBack;
55+
procedure TestFourArgStdFunction;
56+
procedure TestFiveArgCdeclFunction;
4957
procedure TestMemoryMgmt;
5058
procedure TestBug01;
5159
end;
@@ -58,6 +66,17 @@ TMethodCallbackTest = class(TTestCase)
5866

5967
{ TTestObj }
6068

69+
function TTestObj.FiveArgCdeclFunction(arg1, arg2, arg3, arg4,
70+
arg5: integer): integer;
71+
begin
72+
Result := arg1 * arg4 + arg2 * arg5 + arg3;
73+
end;
74+
75+
function TTestObj.FourArgStdFunction(arg1, arg2, arg3, arg4: integer): integer;
76+
begin
77+
Result := arg1 * arg3 + arg2 * arg4;
78+
end;
79+
6180
procedure TTestObj.ThreeArgCdeclProcedure(arg1, arg2, arg3: string);
6281
begin
6382
Argument1:=arg1;
@@ -204,6 +223,24 @@ procedure TMethodCallbackTest.TestDeleteOnEmptyAllocator;
204223
DeleteCallBack(ptr1);
205224
end;
206225

226+
procedure TMethodCallbackTest.TestFiveArgCdeclFunction;
227+
Var
228+
CallBack : TFiveArgCdeclFunction;
229+
begin
230+
CallBack := GetCallBack(fTestObj, @TTestObj.FiveArgCdeclFunction, 5, ctCDECL);
231+
CheckEquals(CallBack(1,2,3,4,5), 1*4+2*5+3);
232+
DeleteCallBack(@CallBack);
233+
end;
234+
235+
procedure TMethodCallbackTest.TestFourArgStdFunction;
236+
Var
237+
CallBack : TFourArgStdFunction;
238+
begin
239+
CallBack := GetCallBack(fTestObj, @TTestObj.FourArgStdFunction, 4, ctSTDCALL);
240+
CheckEquals(CallBack(1,2,3,4), 1*3+2*4);
241+
DeleteCallBack(@CallBack);
242+
end;
243+
207244
procedure TMethodCallbackTest.TestMemoryMgmt;
208245
var
209246
i: integer;
Binary file not shown.

0 commit comments

Comments
 (0)