blob: d1e7e44ea1c99711744cbaac8f51be7c1c891cfa (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
|
program gmp_accept_test;
{$mode objfpc}{$H+}
uses
heaptrc, testutils, strutils, math, sysutils, gmp, classes;
type
TTestCase = class(TPersistent);
TTestCases = class of TTestCase;
{$include gmp_test_intf}
{$include gmp_test_impl}
procedure Run(Tests: array of TTestCases);
var
TestObj: TTestCase;
MethodList: TStringList;
TI, MI: integer;
Test: procedure of object;
begin
for TI := 0 to Length(Tests) - 1 do begin
TestObj := Tests[TI].Create;
MethodList := TStringList.Create;
try
TMethod(Test).Data := TestObj;
GetMethodList(TestObj, MethodList);
for MI := 0 to MethodList.Count - 1 do begin
TMethod(Test).Code := MethodList.Objects[MI];
Test;
end;
WriteLn(Format('%s: Tests executed: %d.', [TestObj.ClassName, MethodList.Count]));
finally
MethodList.Free;
TestObj.Free;
end;
end;
end;
begin
HaltOnNotReleased := True; // exit code wanted
Run([TTestGmpBinding, TTestGmpExtensions, TTestGmpOperators]);
end.
|
