Skip to content

Commit cc9411a

Browse files
mrcsmsmrcsms
committed
wrapdelphi - tests for event handlers
1 parent 46fb96a commit cc9411a

File tree

3 files changed

+317
-1
lines changed

3 files changed

+317
-1
lines changed

‎.gitignore‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,7 @@
33
*.dcu
44
*.obj
55
*.exe
6+
*.dll
67
*.bpl
78
*.bpi
89
*.dcp
@@ -46,3 +47,4 @@
4647
*.Patch
4748
*.#00
4849
*.pch
50+
/Tests/TestInsightSettings.ini

‎Tests/P4DTests.dpr‎

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -6,17 +6,21 @@ program P4DTests;
66
{$APPTYPE CONSOLE}
77
{$ENDIF}{$STRONGLINKTYPES ON}
88
uses
9+
{$IFDEF FASTMM4}
10+
FastMM4,
11+
{$ENDIF}
912
System.SysUtils,
1013
{$IFDEF TESTINSIGHT}
1114
TestInsight.DUnitX,
12-
{$ENDIF }
15+
{$ENDIF}
1316
DUnitX.Loggers.Console,
1417
DUnitX.Loggers.Xml.NUnit,
1518
DUnitX.StackTrace.Jcl,
1619
DUnitX.TestFramework,
1720
MethodCallBackTest in 'MethodCallBackTest.pas',
1821
VarPythTest in 'VarPythTest.pas',
1922
WrapDelphiTest in 'WrapDelphiTest.pas',
23+
WrapDelphiEventHandlerTest in 'WrapDelphiEventHandlerTest.pas',
2024
NumberServicesTest in 'NumberServicesTest.pas';
2125

2226
var

‎Tests/WrapDelphiEventHandlerTest.pas‎

Lines changed: 310 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,310 @@
1+
unit WrapDelphiEventHandlerTest;
2+
3+
interface
4+
5+
uses
6+
Types,
7+
DUnitX.TestFramework,
8+
PythonEngine,
9+
WrapDelphi, System.Classes;
10+
11+
type
12+
TTestGetObjectEvent = procedure(Sender: TObject; var AObject: TObject) of object;
13+
TTestGetValueEvent = procedure(Sender: TObject; var AValue: Double) of object;
14+
15+
TTest = class(TComponent)
16+
private
17+
FObject: TObject;
18+
FValue: Double;
19+
FOnGetObject: TTestGetObjectEvent;
20+
FOnGetValue: TTestGetValueEvent;
21+
22+
ProcessCalled: Boolean;
23+
24+
public
25+
procedure Process;
26+
27+
published
28+
property OnGetObject: TTestGetObjectEvent read FOnGetObject write FOnGetObject;
29+
property OnGetValue: TTestGetValueEvent read FOnGetValue write FOnGetValue;
30+
end;
31+
32+
33+
[TestFixture]
34+
TTestWrapDelphiEventHandlers = class(TObject)
35+
private
36+
PythonEngine: TPythonEngine;
37+
DelphiModule: TPythonModule;
38+
DelphiWrapper: TPyDelphiWrapper;
39+
40+
public
41+
[SetupFixture]
42+
procedure SetupFixture;
43+
44+
[TearDownFixture]
45+
procedure TearDownFixture;
46+
47+
[Test]
48+
procedure TestProcessWithValue;
49+
[Test]
50+
procedure TestProcessWithObject;
51+
end;
52+
53+
implementation
54+
55+
uses
56+
TypInfo;
57+
58+
type
59+
TTestRegistration = class(TRegisteredUnit)
60+
public
61+
function Name: string; override;
62+
procedure RegisterWrappers(APyDelphiWrapper: TPyDelphiWrapper); override;
63+
end;
64+
65+
TTestGetValueEventHandler = class(TEventHandler)
66+
protected
67+
procedure DoEvent(Sender: TObject; var Value: Double);
68+
public
69+
constructor Create(PyDelphiWrapper: TPyDelphiWrapper; Component: TObject;
70+
PropertyInfo: PPropInfo; Callable: PPyObject); override;
71+
class function GetTypeInfo: PTypeInfo; override;
72+
end;
73+
74+
TTestGetObjectEventHandler = class(TEventHandler)
75+
protected
76+
procedure DoEvent(Sender: TObject; var Obj: TObject);
77+
78+
public
79+
constructor Create(PyDelphiWrapper: TPyDelphiWrapper; Component: TObject;
80+
PropertyInfo: PPropInfo; Callable: PPyObject); override;
81+
class function GetTypeInfo: PTypeInfo; override;
82+
end;
83+
84+
85+
{ TTestRegistration }
86+
87+
function TTestRegistration.Name: string;
88+
begin
89+
Result := 'Test';
90+
end;
91+
92+
procedure TTestRegistration.RegisterWrappers(APyDelphiWrapper: TPyDelphiWrapper);
93+
begin
94+
inherited;
95+
APyDelphiWrapper.EventHandlers.RegisterHandler(TTestGetValueEventHandler);
96+
APyDelphiWrapper.EventHandlers.RegisterHandler(TTestGetObjectEventHandler);
97+
end;
98+
99+
100+
{ TTestGetValueEventHandler }
101+
102+
constructor TTestGetValueEventHandler.Create(PyDelphiWrapper: TPyDelphiWrapper; Component: TObject;
103+
PropertyInfo: PPropInfo; Callable: PPyObject);
104+
var
105+
Method: TMethod;
106+
begin
107+
inherited;
108+
Method.Code := @TTestGetValueEventHandler.DoEvent;
109+
Method.Data := Self;
110+
SetMethodProp(Component, PropertyInfo, Method);
111+
end;
112+
113+
procedure TTestGetValueEventHandler.DoEvent(Sender: TObject; var Value: Double);
114+
var
115+
PySender: PPyObject;
116+
PyValue: PPyObject;
117+
PyArgs: PPyObject;
118+
PyResult: PPyObject;
119+
PyValueVarParam: TPyDelphiVarParameter;
120+
begin
121+
if not Assigned(PyDelphiWrapper) or not Assigned(Callable) or not PythonOk then
122+
Exit;
123+
with PyDelphiWrapper.Engine do
124+
begin
125+
PySender := PyDelphiWrapper.Wrap(Sender);
126+
PyValue := CreateVarParam(PyDelphiWrapper, Value);
127+
PyValueVarParam := PythonToDelphi(PyValue) as TPyDelphiVarParameter;
128+
PyArgs := PyTuple_New(2);
129+
PyTuple_SetItem(PyArgs, 0, PySender);
130+
PyTuple_SetItem(PyArgs, 1, PyValue);
131+
try
132+
PyResult := PyObject_CallObject(Callable, PyArgs);
133+
if Assigned(PyResult) then
134+
begin
135+
Py_XDECREF(PyResult);
136+
Value := PyObjectAsVariant(PyValueVarParam.Value);
137+
end;
138+
finally
139+
Py_DECREF(PyArgs)
140+
end;
141+
CheckError;
142+
end;
143+
end;
144+
145+
class function TTestGetValueEventHandler.GetTypeInfo: PTypeInfo;
146+
begin
147+
Result := System.TypeInfo(TTestGetValueEvent);
148+
end;
149+
150+
151+
{ TTestGetObjectEventHandler }
152+
153+
constructor TTestGetObjectEventHandler.Create(PyDelphiWrapper: TPyDelphiWrapper; Component: TObject;
154+
PropertyInfo: PPropInfo; Callable: PPyObject);
155+
var
156+
Method: TMethod;
157+
begin
158+
inherited;
159+
Method.Code := @TTestGetObjectEventHandler.DoEvent;
160+
Method.Data := Self;
161+
SetMethodProp(Component, PropertyInfo, Method);
162+
end;
163+
164+
procedure TTestGetObjectEventHandler.DoEvent(Sender: TObject; var Obj: TObject);
165+
var
166+
PySender: PPyObject;
167+
PyObj: PPyObject;
168+
PyArgs: PPyObject;
169+
PyResult: PPyObject;
170+
PyObjVarParam: TPyDelphiVarParameter;
171+
begin
172+
if not Assigned(PyDelphiWrapper) or not Assigned(Callable) or not PythonOk then
173+
Exit;
174+
with PyDelphiWrapper.Engine do
175+
begin
176+
PySender := PyDelphiWrapper.Wrap(Sender);
177+
PyObj := CreateVarParam(PyDelphiWrapper, Obj);
178+
PyObjVarParam := PythonToDelphi(PyObj) as TPyDelphiVarParameter;
179+
PyArgs := PyTuple_New(2);
180+
PyTuple_SetItem(PyArgs, 0, PySender);
181+
PyTuple_SetItem(PyArgs, 1, PyObj);
182+
try
183+
PyResult := PyObject_CallObject(Callable, PyArgs);
184+
if Assigned(PyResult) then
185+
begin
186+
Py_XDECREF(PyResult);
187+
Obj := (PythonToDelphi(PyObjVarParam.Value) as TPyDelphiObject).DelphiObject;
188+
end;
189+
finally
190+
Py_DECREF(PyArgs)
191+
end;
192+
CheckError;
193+
end;
194+
end;
195+
196+
class function TTestGetObjectEventHandler.GetTypeInfo: PTypeInfo;
197+
begin
198+
Result := System.TypeInfo(TTestGetObjectEvent);
199+
end;
200+
201+
202+
{ TTest }
203+
204+
procedure TTest.Process;
205+
begin
206+
ProcessCalled := True;
207+
if Assigned(FOnGetObject) then
208+
FOnGetObject(Self, FObject);
209+
if Assigned(FOnGetValue) then
210+
FOnGetValue(Self, FValue);
211+
end;
212+
213+
214+
{ TTestWrapDelphiEventHandlers }
215+
216+
procedure TTestWrapDelphiEventHandlers.SetupFixture;
217+
begin
218+
PythonEngine := TPythonEngine.Create(nil);
219+
PythonEngine.Name := 'PythonEngine';
220+
PythonEngine.AutoLoad := False;
221+
PythonEngine.FatalAbort := True;
222+
PythonEngine.FatalMsgDlg := True;
223+
PythonEngine.UseLastKnownVersion := True;
224+
PythonEngine.AutoFinalize := True;
225+
PythonEngine.InitThreads := True;
226+
PythonEngine.PyFlags := [pfInteractive];
227+
DelphiModule := TPythonModule.Create(nil);
228+
229+
DelphiModule.Name := 'DelphiModule';
230+
DelphiModule.Engine := PythonEngine;
231+
DelphiModule.ModuleName := 'delphi';
232+
233+
DelphiWrapper := TPyDelphiWrapper.Create(nil);
234+
235+
DelphiWrapper.Name := 'PyDelphiWrapper';
236+
DelphiWrapper.Engine := PythonEngine;
237+
DelphiWrapper.Module := DelphiModule;
238+
239+
PythonEngine.LoadDll;
240+
end;
241+
242+
procedure TTestWrapDelphiEventHandlers.TearDownFixture;
243+
begin
244+
PythonEngine.Free;
245+
DelphiWrapper.Free;
246+
DelphiModule.Free;
247+
end;
248+
249+
procedure TTestWrapDelphiEventHandlers.TestProcessWithValue;
250+
var
251+
Test: TTest;
252+
pyTest: PPyObject;
253+
begin
254+
Test := TTest.Create(nil);
255+
try
256+
pyTest := DelphiWrapper.Wrap(Test);
257+
DelphiModule.SetVar('test', pyTest);
258+
PythonEngine.Py_DECREF(pyTest);
259+
PythonEngine.ExecString(
260+
'import delphi' + LF +
261+
'' + LF +
262+
'def MyOnGetValue(sender, value):' + LF +
263+
' value.Value = 3.14' + LF +
264+
'' + LF +
265+
'delphi.test.OnGetValue = MyOnGetValue' + LF +
266+
'delphi.test.Process()' + LF +
267+
''
268+
);
269+
Assert.IsTrue(Test.ProcessCalled);
270+
Assert.AreEqual(Test.FValue, 3.14);
271+
finally
272+
Test.Free;
273+
end;
274+
end;
275+
276+
277+
procedure TTestWrapDelphiEventHandlers.TestProcessWithObject;
278+
var
279+
Test: TTest;
280+
pyTest: PPyObject;
281+
begin
282+
Test := TTest.Create(nil);
283+
try
284+
pyTest := DelphiWrapper.Wrap(Test);
285+
DelphiModule.SetVar('test', pyTest);
286+
PythonEngine.Py_DECREF(pyTest);
287+
PythonEngine.ExecString(
288+
'import delphi' + LF +
289+
'' + LF +
290+
'def MyOnGetObject(sender, value):' + LF +
291+
' value.Value = sender' + LF +
292+
'' + LF +
293+
'delphi.test.OnGetObject = MyOnGetObject' + LF +
294+
'delphi.test.Process()' + LF +
295+
''
296+
);
297+
Assert.IsTrue(Test.ProcessCalled);
298+
Assert.AreSame(Test, Test.FObject);
299+
finally
300+
Test.Free;
301+
end;
302+
end;
303+
304+
initialization
305+
306+
RegisteredUnits.Add(TTestRegistration.Create);
307+
308+
TDUnitX.RegisterTestFixture(TTestWrapDelphiEventHandlers);
309+
310+
end.

0 commit comments

Comments
 (0)