@@ -24,14 +24,20 @@ interface
24
24
25
25
implementation
26
26
27
+
27
28
type
29
+ TFourArgStdFunction = function(arg1, arg2, arg3, arg4: integer): integer; stdcall;
30
+ TFiveArgCdeclFunction = function(arg1, arg2, arg3, arg4, arg5: integer): integer; cdecl;
31
+
28
32
TTestObj = class (TObject)
29
33
public
30
34
Argument1: string;
31
35
Argument2: string;
32
36
Argument3: string;
33
37
function TwoArgStdFunction (arg1: string; arg2: string): integer; stdcall;
34
38
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;
35
41
end ;
36
42
37
43
TMethodCallbackTest = class (TTestCase)
@@ -46,6 +52,8 @@ TMethodCallbackTest = class(TTestCase)
46
52
procedure TestOfObjectCallBackStdCall ;
47
53
procedure TestOfObjectCallBackCDecl ;
48
54
procedure TestDeleteCallBack ;
55
+ procedure TestFourArgStdFunction ;
56
+ procedure TestFiveArgCdeclFunction ;
49
57
procedure TestMemoryMgmt ;
50
58
procedure TestBug01 ;
51
59
end ;
@@ -58,6 +66,17 @@ TMethodCallbackTest = class(TTestCase)
58
66
59
67
{ TTestObj }
60
68
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
+
61
80
procedure TTestObj.ThreeArgCdeclProcedure (arg1, arg2, arg3: string);
62
81
begin
63
82
Argument1:=arg1;
@@ -204,6 +223,24 @@ procedure TMethodCallbackTest.TestDeleteOnEmptyAllocator;
204
223
DeleteCallBack(ptr1);
205
224
end ;
206
225
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
+
207
244
procedure TMethodCallbackTest.TestMemoryMgmt ;
208
245
var
209
246
i: integer;
0 commit comments