Skip to content

Commit 82c5564

Browse files
pyscripterpyscripter
committed
Revamped Unit tests using DUniX.
Added extesive VarPyth tests for Python 3.
1 parent 61c8724 commit 82c5564

File tree

8 files changed

+2206
-198
lines changed

8 files changed

+2206
-198
lines changed

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

Lines changed: 62 additions & 49 deletions
Original file line numberDiff line numberDiff line change
@@ -20,50 +20,65 @@
2020
interface
2121

2222
uses
23-
TestFramework, MethodCallback;
23+
DUnitX.TestFramework,
24+
MethodCallback;
2425

2526
implementation
2627

2728

2829
type
30+
TTwoArgStdFunction = function (arg1, arg2: string): integer; stdcall;
31+
TThreeArgCDeclProcedure = procedure (arg1, arg2, arg3: string); cdecl;
32+
2933
TFourArgStdFunction = function(arg1, arg2, arg3, arg4: integer): integer; stdcall;
3034
TFiveArgCdeclFunction = function(arg1, arg2, arg3, arg4, arg5: integer): integer; cdecl;
3135

32-
TTestObj = class(TObject)
36+
TMyFuncCallback = function(arg1, arg2: string): integer of object; stdcall;
37+
TMyProcCallback = procedure (arg1, arg2, arg3: string) of object; cdecl;
38+
39+
40+
TTestObj = class
3341
public
3442
Argument1: string;
3543
Argument2: string;
3644
Argument3: string;
37-
function TwoArgStdFunction(arg1: string; arg2: string): integer; stdcall;
38-
procedure ThreeArgCdeclProcedure(arg1: string; arg2: string; arg3: string); cdecl;
45+
function TwoArgStdFunction(arg1, arg2: string): integer; stdcall;
46+
procedure ThreeArgCdeclProcedure(arg1, arg2, arg3: string); cdecl;
3947
function FourArgStdFunction(arg1, arg2, arg3, arg4: integer): integer; stdcall;
4048
function FiveArgCdeclFunction(arg1, arg2, arg3, arg4, arg5: integer): integer; cdecl;
4149
end;
4250

43-
TMethodCallbackTest = class(TTestCase)
44-
protected
51+
[TestFixture]
52+
TMethodCallbackTest = class
53+
private
4554
fTestObj: TTestObj;
46-
procedure Setup; override;
47-
procedure Teardown; override;
48-
published
55+
public
56+
[SetupFixture]
57+
procedure SetupFixture;
58+
[TearDownFixture]
59+
procedure Teardown;
60+
[Test]
4961
procedure TestDeleteOnEmptyAllocator;
62+
[Test]
5063
procedure TestCallBackStdCall;
64+
[Test]
5165
procedure TestCallBackCDecl;
66+
[Test]
5267
procedure TestOfObjectCallBackStdCall;
68+
[Test]
5369
procedure TestOfObjectCallBackCDecl;
70+
[Test]
5471
procedure TestDeleteCallBack;
72+
[Test]
5573
procedure TestFourArgStdFunction;
74+
[Test]
5675
procedure TestFiveArgCdeclFunction;
76+
[Test]
5777
procedure TestMemoryMgmt;
78+
[Test]
5879
procedure TestBug01;
5980
end;
6081

61-
TTwoArgStdFunction = function (arg1, arg2: string): integer; stdcall;
62-
TThreeArgCDeclProcedure = procedure (arg1, arg2, arg3: string); cdecl;
63-
64-
TMyFuncCallback = function(arg1, arg2: string): integer of object; stdcall;
65-
TMyProcCallback = procedure (arg1, arg2, arg3: string) of object; cdecl;
66-
6782
{ TTestObj }
6883

6984
function TTestObj.FiveArgCdeclFunction(arg1, arg2, arg3, arg4,
@@ -95,26 +110,23 @@ function TTestObj.TwoArgStdFunction(arg1, arg2: string): integer;
95110

96111
{ TMethodCallbackTest }
97112

98-
procedure TMethodCallbackTest.Setup;
113+
procedure TMethodCallbackTest.SetupFixture;
99114
begin
100-
inherited;
101115
fTestObj:=TTestObj.Create;
102116
end;
103117

104118
procedure TMethodCallbackTest.Teardown;
105119
begin
106120
fTestObj.Free;
107121
FreeCallBacks;
108-
inherited;
109-
110122
end;
111123

112124
procedure TMethodCallbackTest.TestBug01;
113125
const
114126
AllocCount = {$IFDEF CPUX64}51{$ELSE}90{$ENDIF};
115127
var
116128
i: integer;
117-
ptr, ptr1, ptr2: Pointer;
129+
ptr: Pointer;
118130
begin
119131
{
120132
I discovered a severe Bug in my memory manager code in MethodCallbacks.
@@ -142,19 +154,20 @@ procedure TMethodCallbackTest.TestBug01;
142154
// one ThreeArgDecl callback uses 33 bytes code + 4 bytes Next pointer = 37 bytes
143155
// we should be able to allocate 110 Callbacks per page
144156

145-
CheckEquals(0, CodeMemPageCount);
157+
FreeCallBacks;
158+
Assert.AreEqual(0, CodeMemPageCount);
146159

147160
for i:=1 to AllocCount do
148161
ptr:=GetCallBack(fTestObj, @TTestObj.ThreeArgCdeclProcedure, 5, ctCdecl);
149162

150163
// there should still be 1 page allocated
151-
CheckEquals(1, CodeMemPageCount);
164+
Assert.AreEqual(1, CodeMemPageCount);
152165

153166
// get one callback more and we should have 2 pages
154167
ptr:=GetCallBack(fTestObj, @TTestObj.ThreeArgCdeclProcedure, 5, ctCdecl);
155168
// getting CodeMemPageCount would crash as the next page pointer was overwritten by the
156169
// last allocation
157-
CheckEquals(2, CodeMemPageCount);
170+
Assert.AreEqual(2, CodeMemPageCount);
158171

159172
end;
160173

@@ -170,9 +183,9 @@ procedure TMethodCallbackTest.TestCallBackCDecl;
170183

171184
proc('first arg', 'second arg', 'third arg');
172185

173-
CheckEquals('first arg', fTestObj.Argument1);
174-
CheckEquals('second arg', fTestObj.Argument2);
175-
CheckEquals('third arg', fTestObj.Argument3);
186+
Assert.AreEqual('first arg', fTestObj.Argument1);
187+
Assert.AreEqual('second arg', fTestObj.Argument2);
188+
Assert.AreEqual('third arg', fTestObj.Argument3);
176189

177190
end;
178191

@@ -186,9 +199,9 @@ procedure TMethodCallbackTest.TestCallBackStdCall;
186199
//---call method through pointer
187200
func:=TTwoArgStdFunction(ptr);
188201

189-
CheckEquals(1, func('first arg', 'second arg'));
190-
CheckEquals('first arg', fTestObj.Argument1);
191-
CheckEquals('second arg', fTestObj.Argument2);
202+
Assert.AreEqual(1, func('first arg', 'second arg'));
203+
Assert.AreEqual(string('first arg'), fTestObj.Argument1);
204+
Assert.AreEqual(string('second arg'), fTestObj.Argument2);
192205
end;
193206

194207
procedure TMethodCallbackTest.TestDeleteCallBack;
@@ -215,6 +228,7 @@ procedure TMethodCallbackTest.TestDeleteCallBack;
215228
DeleteCallBack(ptr1);
216229
DeleteCallBack(ptr2);
217230
DeleteCallback(ptr3);
231+
Assert.Pass;
218232
end;
219233

220234
procedure TMethodCallbackTest.TestDeleteOnEmptyAllocator;
@@ -223,14 +237,15 @@ procedure TMethodCallbackTest.TestDeleteOnEmptyAllocator;
223237
begin
224238
ptr1 := nil;
225239
DeleteCallBack(ptr1);
240+
Assert.Pass();
226241
end;
227242

228243
procedure TMethodCallbackTest.TestFiveArgCdeclFunction;
229244
Var
230245
CallBack : TFiveArgCdeclFunction;
231246
begin
232247
CallBack := GetCallBack(fTestObj, @TTestObj.FiveArgCdeclFunction, 5, ctCDECL);
233-
CheckEquals(CallBack(1,2,3,4,5), 1*4+2*5+3);
248+
Assert.AreEqual(CallBack(1,2,3,4,5), 1*4+2*5+3);
234249
DeleteCallBack(@CallBack);
235250
end;
236251

@@ -239,7 +254,7 @@ procedure TMethodCallbackTest.TestFourArgStdFunction;
239254
CallBack : TFourArgStdFunction;
240255
begin
241256
CallBack := GetCallBack(fTestObj, @TTestObj.FourArgStdFunction, 4, ctSTDCALL);
242-
CheckEquals(CallBack(1,2,3,4), 1*3+2*4);
257+
Assert.AreEqual(CallBack(1,2,3,4), 1*3+2*4);
243258
DeleteCallBack(@CallBack);
244259
end;
245260

@@ -255,39 +270,37 @@ procedure TMethodCallbackTest.TestMemoryMgmt;
255270
// one ThreeArgDecl callback uses 33 bytes code + 4 bytes Next pointer = 37 bytes
256271
// we should be able to allocate 110 Callbacks per page
257272

258-
CheckEquals(0, CodeMemPageCount);
273+
FreeCallBacks;
274+
Assert.AreEqual(0, CodeMemPageCount);
259275

260276
for i:=1 to AllocCount do
261277
ptr:=GetCallBack(fTestObj, @TTestObj.ThreeArgCdeclProcedure, 3, ctCdecl);
262278

263279
// there should still be 1 page allocated
264-
CheckEquals(1, CodeMemPageCount);
280+
Assert.AreEqual(1, CodeMemPageCount);
265281

266282
// get one callback more and we should have 2 pages
267283
ptr:=GetCallBack(fTestObj, @TTestObj.ThreeArgCdeclProcedure, 3, ctCdecl);
268-
CheckEquals(2, CodeMemPageCount);
284+
Assert.AreEqual(2, CodeMemPageCount);
269285

270286
// get some more memory
271287
ptr1:=GetCallBack(fTestObj, @TTestObj.ThreeArgCdeclProcedure, 3, ctCdecl);
272288
ptr2:=GetCallBack(fTestObj, @TTestObj.ThreeArgCdeclProcedure, 3, ctCdecl);
273-
CheckEquals(2, CodeMemPageCount);
289+
Assert.AreEqual(2, CodeMemPageCount);
274290

275291

276292
// now Free the callbacks on page 2
277293
DeleteCallBack(ptr1);
278-
CheckEquals(2, CodeMemPageCount);
294+
Assert.AreEqual(2, CodeMemPageCount);
279295
DeleteCallBack(ptr);
280-
CheckEquals(2, CodeMemPageCount);
296+
Assert.AreEqual(2, CodeMemPageCount);
281297
DeleteCallBack(ptr2);
282298
// page count should be back to 1
283-
CheckEquals(1, CodeMemPageCount);
299+
Assert.AreEqual(1, CodeMemPageCount);
284300

285301
// allocate one more and page count should go up to 2 again
286302
ptr:=GetCallBack(fTestObj, @TTestObj.ThreeArgCdeclProcedure, 3, ctCdecl);
287-
CheckEquals(2, CodeMemPageCount);
288-
289-
290-
303+
Assert.AreEqual(2, CodeMemPageCount);
291304
end;
292305

293306
procedure TMethodCallbackTest.TestOfObjectCallBackCDecl;
@@ -304,9 +317,9 @@ procedure TMethodCallbackTest.TestOfObjectCallBackCDecl;
304317

305318
proc('first arg', 'second arg', 'third arg');
306319

307-
CheckEquals('first arg', fTestObj.Argument1);
308-
CheckEquals('second arg', fTestObj.Argument2);
309-
CheckEquals('third arg', fTestObj.Argument3);
320+
Assert.AreEqual('first arg', fTestObj.Argument1);
321+
Assert.AreEqual('second arg', fTestObj.Argument2);
322+
Assert.AreEqual('third arg', fTestObj.Argument3);
310323

311324
end;
312325

@@ -322,13 +335,13 @@ procedure TMethodCallbackTest.TestOfObjectCallBackStdCall;
322335
//---call method through pointer
323336
func:=TTwoArgStdFunction(ptr);
324337

325-
CheckEquals(1, func('first arg', 'second arg'));
326-
CheckEquals('first arg', fTestObj.Argument1);
327-
CheckEquals('second arg', fTestObj.Argument2);
338+
Assert.AreEqual(1, func('first arg', 'second arg'));
339+
Assert.AreEqual('first arg', fTestObj.Argument1);
340+
Assert.AreEqual('second arg', fTestObj.Argument2);
328341
end;
329342

330343

331344
initialization
332-
TestFrameWork.RegisterTest(TMethodCallBackTest.Suite());
345+
TDUnitX.RegisterTestFixture(TMethodCallBackTest);
333346

334347
end.

‎PythonForDelphi/Components/Sources/Core/UnitTests/P4DTests.dpr‎

Lines changed: 63 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,63 @@
1+
// JCL_DEBUG_EXPERT_GENERATEJDBG ON
2+
// JCL_DEBUG_EXPERT_INSERTJDBG ON
3+
// JCL_DEBUG_EXPERT_DELETEMAPFILE OFF
4+
program P4DTests;
5+
{$IFNDEF TESTINSIGHT}
6+
{$APPTYPE CONSOLE}
7+
{$ENDIF}{$STRONGLINKTYPES ON}
8+
uses
9+
System.SysUtils,
10+
{$IFDEF TESTINSIGHT}
11+
TestInsight.DUnitX,
12+
{$ENDIF }
13+
DUnitX.Loggers.Console,
14+
DUnitX.Loggers.Xml.NUnit,
15+
DUnitX.StackTrace.Jcl,
16+
DUnitX.TestFramework,
17+
VarPythTest in 'VarPythTest.pas',
18+
MethodCallBackTest in 'MethodCallBackTest.pas';
19+
20+
var
21+
runner : ITestRunner;
22+
results : IRunResults;
23+
logger : ITestLogger;
24+
nunitLogger : ITestLogger;
25+
begin
26+
{$IFDEF TESTINSIGHT}
27+
TestInsight.DUnitX.RunRegisteredTests;
28+
exit;
29+
{$ENDIF}
30+
try
31+
//Check command line options, will exit if invalid
32+
TDUnitX.CheckCommandLine;
33+
//Create the test runner
34+
runner := TDUnitX.CreateRunner;
35+
//Tell the runner to use RTTI to find Fixtures
36+
runner.UseRTTI := True;
37+
//tell the runner how we will log things
38+
//Log to the console window
39+
logger := TDUnitXConsoleLogger.Create(true);
40+
runner.AddLogger(logger);
41+
//Generate an NUnit compatible XML File
42+
nunitLogger := TDUnitXXMLNUnitFileLogger.Create(TDUnitX.Options.XMLOutputFile);
43+
runner.AddLogger(nunitLogger);
44+
runner.FailsOnNoAsserts := False; //When true, Assertions must be made during tests;
45+
46+
//Run tests
47+
results := runner.Execute;
48+
if not results.AllPassed then
49+
System.ExitCode := EXIT_ERRORS;
50+
51+
{$IFNDEF CI}
52+
//We don't want this happening when running under CI.
53+
if TDUnitX.Options.ExitBehavior = TDUnitXExitBehavior.Pause then
54+
begin
55+
System.Write('Done.. press <Enter> key to quit.');
56+
System.Readln;
57+
end;
58+
{$ENDIF}
59+
except
60+
on E: Exception do
61+
System.Writeln(E.ClassName, ': ', E.Message);
62+
end;
63+
end.

0 commit comments

Comments
 (0)