paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-10-23 23:21:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

fpcunit: guitestrunner: handle xml errors

Browse Source 
git-svn-id: trunk@40832 -
This commit is contained in:
mattias 2013-04-17 08:01:05 +00:00
parent 2ef3cf5a5c
commit 88212d1ab2
2 changed files with 43 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
components/fpcunit/guitestrunner.lfm
View File

@ -83,7 +83,7 @@ object GUITestRunner: TGUITestRunner
Left = 7
Height = 34
Top = 7
Width = 78
Width = 80
Action = RunAction
AutoSize = True
BorderSpacing.Around = 6
@ -172,10 +172,10 @@ object GUITestRunner: TGUITestRunner
AnchorSideTop.Control = Panel1
AnchorSideRight.Control = Panel1
AnchorSideRight.Side = asrBottom
Left = 489
Left = 486
Height = 34
Top = 7
Width = 79
Width = 82
Action = ActCloseForm
Anchors = [akTop, akRight]
AutoSize = True
@ -266,10 +266,10 @@ object GUITestRunner: TGUITestRunner
AnchorSideLeft.Control = BtnRun
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Panel1
Left = 91
Left = 93
Height = 32
Top = 7
Width = 147
Width = 158
Action = ActRunHighlightedTest
AutoSize = True
BorderSpacing.Around = 6
@ -367,27 +367,27 @@ object GUITestRunner: TGUITestRunner
TabOrder = 0
object tsTestTree: TTabSheet
Caption = 'Testcase tree'
ClientHeight = 474
ClientHeight = 472
ClientWidth = 565
object Splitter1: TSplitter
Cursor = crVSplit
Left = 0
Height = 5
Top = 336
Top = 334
Width = 565
Align = alBottom
ResizeAnchor = akBottom
end
object TestTree: TTreeView
Left = 6
Height = 324
Height = 322
Top = 6
Width = 553
Align = alClient
BorderSpacing.Around = 6
BackgroundColor = clBtnFace
Color = clBtnFace
DefaultItemHeight = 16
DefaultItemHeight = 18
Images = TestTreeImageList
PopupMenu = PopupMenu3
ReadOnly = True
@ -403,7 +403,7 @@ object GUITestRunner: TGUITestRunner
object Memo1: TMemo
Left = 6
Height = 121
Top = 347
Top = 345
Width = 553
Align = alBottom
BorderSpacing.Around = 6
@ -850,6 +850,12 @@ object GUITestRunner: TGUITestRunner
end>
VisibleSpecialChars = [vscSpace, vscTabAtLast]
ReadOnly = True
SelectedColor.BackPriority = 50
SelectedColor.ForePriority = 50
SelectedColor.FramePriority = 50
SelectedColor.BoldPriority = 50
SelectedColor.ItalicPriority = 50
SelectedColor.UnderlinePriority = 50
BracketHighlightStyle = sbhsBoth
BracketMatchColor.Background = clNone
BracketMatchColor.Foreground = clNone
@ -885,6 +891,8 @@ object GUITestRunner: TGUITestRunner
object TSynGutterSeparator
Width = 2
MouseActions = <>
MarkupInfo.Background = clWhite
MarkupInfo.Foreground = clGray
end
object TSynGutterCodeFolding
MouseActions = <

40
components/fpcunit/guitestrunner.pas
View File

@ -724,26 +724,36 @@ begin
TestResult.AddListener(self);
pbBar.Invalidate;
w := TXMLResultsWriter.Create(nil);
w.FileName := 'null'; // prevents output to the console
TestResult.AddListener(w);
try
w.FileName := 'null'; // prevents output to the console
TestResult.AddListener(w);
MemoLog(Format(rsRunning, [TestTree.Selected.Text]));
aTest.Run(TestResult);
MemoLog(Format(rsNumberOfExec, [IntToStr(TestResult.RunTests),
FormatDateTime('hh:nn:ss.zzz', Now - TestResult.StartingTime)]));
MemoLog(Format(rsRunning, [TestTree.Selected.Text]));
aTest.Run(TestResult);
MemoLog(Format(rsNumberOfExec, [IntToStr(TestResult.RunTests),
FormatDateTime('hh:nn:ss.zzz', Now - TestResult.StartingTime)]));
w.WriteResult(TestResult);
m := TMemoryStream.Create;
WriteXMLFile(w.Document, m);
m.Position := 0;
XMLSynEdit.Lines.LoadFromStream(m);
pbBar.Invalidate;
w.WriteResult(TestResult);
m := TMemoryStream.Create;
try
try
WriteXMLFile(w.Document, m);
m.Position := 0;
XMLSynEdit.Lines.LoadFromStream(m);
except
on E: Exception do
XMLSynEdit.Lines.Text:='WriteXMLFile exception: '+E.ClassName+'/'+E.Message;
end;
finally
m.Free;
end;
pbBar.Invalidate;
finally
w.Free;
end;
finally
EnableRunActions(true);
m.free;
w.Free;
TestResult.Free;
end;
end;