fpcunit: feedback and progress animation during testing from Graeme

git-svn-id: trunk@9302 -
This commit is contained in:
mattias 2006-05-18 07:45:28 +00:00
parent 888332de6b
commit 2ae268c57c
6 changed files with 837 additions and 583 deletions

1
.gitattributes vendored
View File

@ -122,6 +122,7 @@ components/customform/lazcustforms.lpk svneol=native#text/plain
components/customform/lazcustforms.pas svneol=native#text/plain
components/fpcunit/Makefile svneol=native#text/plain
components/fpcunit/Makefile.fpc svneol=native#text/plain
components/fpcunit/blueball.xpm svneol=native#text/plain
components/fpcunit/fpcunittestrunner.lpk svneol=native#text/pascal
components/fpcunit/fpcunittestrunner.pas svneol=native#text/pascal
components/fpcunit/guitestrunner.lfm svneol=native#text/plain

View File

@ -7,7 +7,7 @@ version=0.1
[compiler]
unittargetdir=lib/$(CPU_TARGET)-$(OS_TARGET)
unitdir=../../lcl/units/$(CPU_TARGET)-$(OS_TARGET)/ ../../lcl/units/$(CPU_TARGET)-$(OS_TARGET)/$(LCL_PLATFORM)/ ../../packager/units/$(CPU_TARGET)-$(OS_TARGET)/
options=-dLCL -dLCLgtk -S2 -gl
options=-dLCL -dLCL$(LCL_PLATFORM) -S2 -gl
[target]
units=fpcunittestrunner.pas
@ -18,6 +18,16 @@ files=$(wildcard $(COMPILER_UNITTARGETDIR)/*$(OEXT)) \
$(wildcard $(COMPILER_UNITTARGETDIR)/*$(RSTEXT)) \
$(wildcard $(COMPILER_UNITTARGETDIR)/*.compiled) \
$(wildcard *$(OEXT)) $(wildcard *$(PPUEXT)) $(wildcard *$(RSTEXT))
[prerules]
# LCL Platform
ifndef LCL_PLATFORM
ifeq ($(OS_TARGET),win32)
LCL_PLATFORM=win32
else
LCL_PLATFORM=gtk
endif
endif
export LCL_PLATFORM
[rules]
.PHONY: cleartarget all

View File

@ -0,0 +1,96 @@
/* XPM */
static char * blueball_xpm[] = {
"16 16 77 1",
" c None",
". c #000000",
"+ c #D3DCFD",
"@ c #E0E5FD",
"# c #CED8FD",
"$ c #B6C6FD",
"% c #A0B3FC",
"& c #8AA2FB",
"* c #4168F9",
"= c #A0B3FB",
"- c #D6DEFD",
"; c #F1F4FF",
"> c #D5DEFE",
", c #BAC8FD",
"' c #9EB2FC",
") c #839BFC",
"! c #6786FA",
"~ c #5276F9",
"{ c #7E99FA",
"] c #B4C3FD",
"^ c #CDD7FE",
"/ c #DFE6FE",
"( c #DFE5FE",
"_ c #CCD7FE",
": c #B3C4FD",
"< c #99AEFC",
"[ c #7F9AFB",
"} c #6484FB",
"| c #496EFA",
"1 c #3A62F8",
"2 c #5D7EF9",
"3 c #8EA5FC",
"4 c #A6B7FD",
"5 c #B9C7FD",
"6 c #C4D1FD",
"7 c #C5D0FD",
"8 c #8FA5FB",
"9 c #7693FB",
"0 c #5D7DFA",
"a c #4369FA",
"b c #3962F8",
"c c #5B7CF9",
"d c #7E98FB",
"e c #92A8FC",
"f c #A9BBFC",
"g c #A1B4FD",
"h c #91A8FB",
"i c #6887FA",
"j c #5075FA",
"k c #3A63F8",
"l c #5476F9",
"m c #6B89FA",
"n c #7B96FB",
"o c #87A0FC",
"p c #8EA5FB",
"q c #88A0FC",
"r c #6A89FA",
"s c #5779FA",
"t c #4268F9",
"u c #4269F8",
"v c #5478F9",
"w c #6383FA",
"x c #6C8AFA",
"y c #728FFB",
"z c #728FFA",
"A c #6D8BFB",
"B c #6282FA",
"C c #5478FA",
"D c #446AF9",
"E c #3E65F9",
"F c #4A6EF9",
"G c #5276FA",
"H c #5679FA",
"I c #4A6FF9",
"J c #3D65F9",
"K c #3B63F9",
"L c #3963F8",
" ",
" ........ ",
" . +@#$%&*. ",
" ..=-;;>,')!~.. ",
" .{]^/(_:<[}|1. ",
".23456754890a1b.",
".cde%ffghdij1kb.",
".lmnop3qnrstbbk.",
".uvwxyzABCDb11b.",
".bEFGHsGIJb1b1b.",
".b1k1KKbb1b1k1b.",
".1111b1L1111bkb.",
" .b1b1111111bb. ",
" ..b11Lbbkb11.. ",
" .bbbbbb1b. ",
" ........ "};

View File

@ -1,7 +1,7 @@
object GUITestRunner: TGUITestRunner
ActiveControl = tsTestTree
Caption = 'FPCUnit - run unit tests'
ClientHeight = 397
ClientHeight = 613
ClientWidth = 574
Constraints.MinHeight = 200
Constraints.MinWidth = 250
@ -24,13 +24,13 @@ object GUITestRunner: TGUITestRunner
}
OnCreate = GUITestRunnerCreate
OnShow = GUITestRunnerShow
PixelsPerInch = 120
PixelsPerInch = 96
Position = poDesktopCenter
ShowHint = True
HorzScrollBar.Page = 573
VertScrollBar.Page = 396
VertScrollBar.Page = 612
Left = 429
Height = 397
Height = 613
Top = 176
Width = 574
object Panel1: TPanel
@ -55,6 +55,8 @@ object GUITestRunner: TGUITestRunner
BorderSpacing.Bottom = 1
BorderSpacing.Around = 1
Caption = 'Selected Test Suite:'
Color = clNone
ParentColor = False
Left = 144
Height = 18
Top = 10
@ -266,12 +268,12 @@ object GUITestRunner: TGUITestRunner
object Panel2: TPanel
Align = alClient
Caption = 'Panel2'
ClientHeight = 341
ClientHeight = 557
ClientWidth = 574
FullRepaint = False
TabOrder = 1
TabStop = True
Height = 341
Height = 557
Top = 56
Width = 574
object PageControl1: TPageControl
@ -280,41 +282,44 @@ object GUITestRunner: TGUITestRunner
Constraints.MinHeight = 150
TabIndex = 0
TabOrder = 0
TabStop = True
Left = 1
Height = 339
Height = 555
Top = 1
Width = 572
object tsTestTree: TTabSheet
Caption = 'Testcase tree'
ClientHeight = 310
ClientWidth = 564
Height = 310
Width = 564
ClientHeight = 523
ClientWidth = 568
Left = 2
Height = 523
Top = 30
Width = 568
object Panel4: TPanel
Align = alTop
BevelOuter = bvNone
ClientHeight = 63
ClientWidth = 564
ClientWidth = 568
FullRepaint = False
TabOrder = 0
Height = 63
Width = 564
Width = 568
object Panel6: TPanel
Align = alTop
Caption = 'Panel6'
ClientHeight = 50
ClientWidth = 564
ClientWidth = 568
FullRepaint = False
TabOrder = 0
Height = 50
Width = 564
Width = 568
object pbBar: TPaintBox
Align = alClient
OnPaint = pbBarPaint
Left = 1
Height = 48
Top = 1
Width = 562
Width = 566
end
end
end
@ -323,25 +328,25 @@ object GUITestRunner: TGUITestRunner
AutoSize = True
BevelOuter = bvNone
Caption = 'Panel7'
ClientHeight = 158
ClientWidth = 564
ClientHeight = 371
ClientWidth = 568
FullRepaint = False
TabOrder = 1
Height = 158
Height = 371
Top = 63
Width = 564
Width = 568
object TestTree: TTreeView
Align = alClient
BackgroundColor = clBtnFace
Color = clBtnFace
DefaultItemHeight = 19
DefaultItemHeight = 16
Images = ImageList1
PopupMenu = PopupMenu3
ScrollBars = ssAutoBoth
TabOrder = 0
OnSelectionChanged = TestTreeSelectionChanged
Height = 158
Width = 564
Height = 371
Width = 568
end
end
object Panel8: TPanel
@ -349,50 +354,52 @@ object GUITestRunner: TGUITestRunner
BevelOuter = bvNone
Caption = 'Panel8'
ClientHeight = 84
ClientWidth = 564
ClientWidth = 568
Constraints.MinHeight = 80
FullRepaint = False
TabOrder = 2
Height = 84
Top = 226
Width = 564
Top = 439
Width = 568
object Memo1: TMemo
Align = alClient
PopupMenu = PopupMenu2
ScrollBars = ssAutoVertical
TabOrder = 0
Height = 84
Width = 564
Width = 568
end
end
object Splitter1: TSplitter
Align = alBottom
Cursor = crVSplit
Height = 5
Width = 564
Width = 568
ResizeAnchor = akBottom
Cursor = crVSplit
Height = 5
Top = 221
Width = 564
Top = 434
Width = 568
end
end
object tsResultsXML: TTabSheet
Caption = 'Results XML'
ClientHeight = 310
ClientWidth = 564
Height = 310
Width = 564
ClientHeight = 523
ClientWidth = 568
Left = 2
Height = 523
Top = 30
Width = 568
object Panel3: TPanel
Align = alClient
BevelOuter = bvNone
Caption = 'Panel3'
ClientHeight = 309
ClientHeight = 523
ClientWidth = 568
FullRepaint = False
TabOrder = 0
TabStop = True
Height = 309
Height = 523
Width = 568
object Panel5: TPanel
Align = alTop
@ -406,6 +413,7 @@ object GUITestRunner: TGUITestRunner
Width = 568
object SpeedButton1: TSpeedButton
Action = actCopy
Color = clBtnFace
Flat = True
Glyph.Data = {
880D00002F2A2058504D202A2F0A7374617469632063686172202A2065646974
@ -529,6 +537,7 @@ object GUITestRunner: TGUITestRunner
end
object SpeedButton2: TSpeedButton
Action = actCut
Color = clBtnFace
Flat = True
Glyph.Data = {
CC0500002F2A2058504D202A2F0A7374617469632063686172202A2065646974
@ -602,7 +611,7 @@ object GUITestRunner: TGUITestRunner
Align = alClient
PopupMenu = PopupMenu1
TabOrder = 1
Height = 261
Height = 475
Top = 48
Width = 568
end
@ -614,7 +623,7 @@ object GUITestRunner: TGUITestRunner
left = 16
top = 432
Bitmap = {
6C690D00000010000000100000009D0E00002F2A2058504D202A2F0A73746174
6C690E00000010000000100000009D0E00002F2A2058504D202A2F0A73746174
69632063686172202A206C65646C69676874677265656E5F78706D5B5D203D20
7B0A223136203136203139342032222C0A2220200963204E6F6E65222C0A222E
2009632023303234323046222C0A222B2009632023313934383334222C0A2240
@ -1500,7 +1509,55 @@ object GUITestRunner: TGUITestRunner
203D2E2D2E3B2E3E2E3B2E2D2E3D2E4A20512020202020222C0A222020202020
2020202C2E75206820272E292E272E202E212E7E2E202020202020222C0A2220
20202020202020202020207E2E7B2E70205D2E5E2E2020202020202020202022
7D3B0A
7D3B0AFA0500002F2A2058504D202A2F0A7374617469632063686172202A2062
6C756562616C6C5F78706D5B5D203D207B0A2231362031362037372031222C0A
22200963204E6F6E65222C0A222E09632023303030303030222C0A222B096320
23443344434644222C0A224009632023453045354644222C0A22230963202343
4544384644222C0A222409632023423643364644222C0A222509632023413042
334643222C0A222609632023384141324642222C0A222A096320233431363846
39222C0A223D09632023413042334642222C0A222D0963202344364445464422
2C0A223B09632023463146344646222C0A223E09632023443544454645222C0A
222C09632023424143384644222C0A222709632023394542324643222C0A2229
09632023383339424643222C0A222109632023363738364641222C0A227E0963
2023353237364639222C0A227B09632023374539394641222C0A225D09632023
423443334644222C0A225E09632023434444374645222C0A222F096320234446
45364645222C0A222809632023444645354645222C0A225F0963202343434437
4645222C0A223A09632023423343344644222C0A223C09632023393941454643
222C0A225B09632023374639414642222C0A227D09632023363438344642222C
0A227C09632023343936454641222C0A223109632023334136324638222C0A22
3209632023354437454639222C0A223309632023384541354643222C0A223409
632023413642374644222C0A223509632023423943374644222C0A2236096320
23433444314644222C0A223709632023433544304644222C0A22380963202338
4641354642222C0A223909632023373639334642222C0A223009632023354437
444641222C0A226109632023343336394641222C0A2262096320233339363246
38222C0A226309632023354237434639222C0A22640963202337453938464222
2C0A226509632023393241384643222C0A226609632023413942424643222C0A
226709632023413142344644222C0A226809632023393141384642222C0A2269
09632023363838374641222C0A226A09632023353037354641222C0A226B0963
2023334136334638222C0A226C09632023353437364639222C0A226D09632023
364238394641222C0A226E09632023374239364642222C0A226F096320233837
41304643222C0A227009632023384541354642222C0A22710963202338384130
4643222C0A227209632023364138394641222C0A227309632023353737394641
222C0A227409632023343236384639222C0A227509632023343236394638222C
0A227609632023353437384639222C0A227709632023363338334641222C0A22
7809632023364338414641222C0A227909632023373238464642222C0A227A09
632023373238464641222C0A224109632023364438424642222C0A2242096320
23363238324641222C0A224309632023353437384641222C0A22440963202334
3436414639222C0A224509632023334536354639222C0A224609632023344136
454639222C0A224709632023353237364641222C0A2248096320233536373946
41222C0A224909632023344136464639222C0A224A0963202333443635463922
2C0A224B09632023334236334639222C0A224C09632023333936334638222C0A
2220202020202020202020202020202020222C0A22202020202E2E2E2E2E2E2E
2E20202020222C0A222020202E202B40232425262A2E202020222C0A22202E2E
3D2D3B3B3E2C2729217E2E2E20222C0A22202E7B5D5E2F285F3A3C5B7D7C312E
20222C0A222E32333435363735343839306131622E222C0A222E636465256666
676864696A316B622E222C0A222E6C6D6E6F7033716E72737462626B2E222C0A
222E75767778797A41424344623131622E222C0A222E62454647487347494A62
316231622E222C0A222E62316B314B4B62623162316B31622E222C0A222E3131
313162314C31313131626B622E222C0A22202E6231623131313131313162622E
20222C0A22202E2E6231314C62626B6231312E2E20222C0A222020202E626262
62626231622E202020222C0A22202020202E2E2E2E2E2E2E2E20202020227D3B
0A
}
end
object ActionList1: TActionList

File diff suppressed because it is too large Load Diff

View File

@ -95,6 +95,7 @@ type
procedure PaintNodeError(aNode: TTreeNode);
procedure PaintNodeFailure(aNode: TTreeNode);
procedure PaintNodeNonFailed(aNode: TTreeNode);
procedure PaintNodeBusy(aNode: TTreeNode);
procedure MemoLog(LogEntry: string);
public
procedure AddFailure(ATest: TTest; AFailure: TTestFailure);
@ -115,12 +116,14 @@ begin
Clipboard.AsText := XMLMemo.Lines.Text;
end;
procedure TGUITestRunner.actCutExecute(Sender: TObject);
begin
Clipboard.AsText := XMLMemo.Lines.Text;
XMLMemo.Lines.Clear;
end;
procedure TGUITestRunner.GUITestRunnerCreate(Sender: TObject);
begin
barColor := clGreen;
@ -128,6 +131,7 @@ begin
BuildTree(TestTree.Items.AddObject(nil, 'All Tests', GetTestRegistry), GetTestRegistry);
end;
procedure TGUITestRunner.RunExecute(Sender: TObject);
var
testResult:TTestResult;
@ -168,28 +172,33 @@ begin
end;
end;
procedure TGUITestRunner.ActCloseFormExecute(Sender: TObject);
begin
Close;
end;
procedure TGUITestRunner.RunActionUpdate(Sender: TObject);
begin
(Sender as TAction).Enabled := ((TestTree.Selected <> nil)
and (TestTree.Selected.Data <> nil)) or (not TestTree.Focused);
end;
procedure TGUITestRunner.GUITestRunnerShow(Sender: TObject);
begin
if (ParamStr(1) = '--now') or (ParamStr(1) = '-n') then
RunExecute(Self);
end;
procedure TGUITestRunner.MenuItem3Click(Sender: TObject);
begin
Clipboard.AsText := Memo1.Lines.Text;
end;
procedure TGUITestRunner.TestTreeSelectionChanged(Sender: TObject);
begin
if ((Sender as TTreeView).Selected <> nil) and
@ -199,17 +208,20 @@ begin
lblSelectedTest.Caption := '';
end;
procedure TGUITestRunner.actCopyErrorMsgExecute(Sender: TObject);
begin
ClipBoard.AsText := Copy(TestTree.Selected.text, 10, MaxInt)
end;
procedure TGUITestRunner.actCopyErrorMsgUpdate(Sender: TObject);
begin
(Sender as TAction).Enabled := Assigned(TestTree.selected) and
(Copy(TestTree.Selected.Text, 1, 9) = 'Message: ');
end;
procedure TGUITestRunner.pbBarPaint(Sender: TObject);
var
msg: string;
@ -240,6 +252,7 @@ begin
end;
end;
procedure TGUITestRunner.BuildTree(rootNode: TTreeNode; aSuite: TTestSuite);
var
node: TTreeNode;
@ -260,6 +273,7 @@ begin
ResetNodeColors;
end;
function TGUITestRunner.FindNode(aTest: TTest): TTreeNode;
var
i: integer;
@ -273,6 +287,7 @@ begin
end;
end;
procedure TGUITestRunner.ResetNodeColors;
var
i: integer;
@ -284,6 +299,7 @@ begin
end;
end;
procedure TGUITestRunner.PaintNodeError(aNode: TTreeNode);
begin
while Assigned(aNode) do
@ -292,27 +308,29 @@ begin
aNode.SelectedIndex := 2;
aNode.Expand(True);
aNode := aNode.Parent;
if Assigned(aNode) and (aNode.ImageIndex in [0, 3, 12, -1]) then
if Assigned(aNode) and (aNode.ImageIndex in [0, 3, 12, 13, -1]) then
PaintNodeError(aNode);
end;
end;
procedure TGUITestRunner.PaintNodeFailure(aNode: TTreeNode);
begin
while Assigned(aNode) do
begin
if aNode.ImageIndex in [0, -1, 12] then
if aNode.ImageIndex in [0, -1, 12, 13] then
begin
aNode.ImageIndex := 3;
aNode.SelectedIndex := 3;
aNode.Expand(true);
end;
aNode := aNode.Parent;
if Assigned(aNode) and (aNode.ImageIndex in [0, -1, 12]) then
if Assigned(aNode) and (aNode.ImageIndex in [0, -1, 12, 13]) then
PaintNodeFailure(aNode);
end;
end;
procedure TGUITestRunner.PaintNodeNonFailed(aNode: TTreeNode);
var
noFailedSibling: boolean;
@ -320,7 +338,7 @@ var
begin
if Assigned(aNode) then
begin
if aNode.ImageIndex in [12, -1] then
if aNode.ImageIndex in [12, 13, -1] then
begin
aNode.ImageIndex := 0;
aNode.SelectedIndex := 0;
@ -336,11 +354,40 @@ begin
if aNode.Items[i].ImageIndex <> 0 then
noFailedSibling := false;;
end;
if (aNode.ImageIndex = 12) and noFailedSibling then
if (aNode.ImageIndex = 13) and noFailedSibling then
PaintNodeNonFailed(aNode);
end;
end;
procedure TGUITestRunner.PaintNodeBusy(aNode: TTreeNode);
var
BusySibling: boolean;
i: integer;
begin
if Assigned(aNode) then
begin
aNode.ImageIndex := 13;
aNode.SelectedIndex := 13;
end;
if Assigned(aNode.Parent) then
begin
if aNode.Index = aNode.Parent.Count -1 then
begin
aNode := aNode.Parent;
BusySibling := true;
for i := 0 to aNode.Count -2 do
begin
if aNode.Items[i].ImageIndex <> 0 then
BusySibling := false;;
end;
if (aNode.ImageIndex = 12) and BusySibling then
PaintNodeBusy(aNode);
end;
end;
end;
procedure TGUITestRunner.MemoLog(LogEntry: string);
begin
Memo1.Lines.Add(TimeToStr(Now) + ' - ' + LogEntry);
@ -368,6 +415,7 @@ begin
barColor := clFuchsia;
end;
procedure TGUITestRunner.AddError(ATest: TTest; AError: TTestFailure);
var
ErrorNode, node: TTreeNode;
@ -403,20 +451,31 @@ begin
barColor := clRed;
end;
procedure TGUITestRunner.StartTest(ATest: TTest);
var
Node: TTreeNode;
begin
//if ATest=0 then ;
TestTree.BeginUpdate;
Node := FindNode(ATest);
PaintNodeBusy(Node);
Application.ProcessMessages;
TestTree.EndUpdate;
end;
procedure TGUITestRunner.EndTest(ATest: TTest);
var
Node: TTreeNode;
begin
TestTree.BeginUpdate;
Inc(testsCounter);
Node := FindNode(ATest);
PaintNodeNonFailed(Node);
pbbar.Refresh;
pbbar1.Refresh;
Application.ProcessMessages;
TestTree.EndUpdate;
end;
initialization