--- /cygdrive/C/lazarus/components/fpcunit/guitestrunner.lfm	2014-05-06 23:52:07.524235000 +0200
+++ guitestrunner.lfm	2015-04-02 15:32:08.231268800 +0200
@@ -46,7 +46,7 @@
   OnShow = GUITestRunnerShow
   Position = poScreenCenter
   ShowHint = True
-  LCLVersion = '1.3'
+  LCLVersion = '1.2.6.0'
   object Panel1: TPanel
     Left = 0
     Height = 88
@@ -172,10 +172,10 @@
       AnchorSideTop.Control = Panel1
       AnchorSideRight.Control = Panel1
       AnchorSideRight.Side = asrBottom
-      Left = 488
+      Left = 482
       Height = 34
       Top = 7
-      Width = 80
+      Width = 86
       Action = ActCloseForm
       Anchors = [akTop, akRight]
       AutoSize = True
@@ -269,7 +269,7 @@
       Left = 92
       Height = 32
       Top = 7
-      Width = 148
+      Width = 174
       Action = ActRunHighlightedTest
       AutoSize = True
       BorderSpacing.Around = 6
@@ -367,27 +367,26 @@
       TabOrder = 0
       object tsTestTree: TTabSheet
         Caption = 'Testcase tree'
-        ClientHeight = 474
+        ClientHeight = 470
         ClientWidth = 565
         object Splitter1: TSplitter
           Cursor = crVSplit
           Left = 0
           Height = 5
-          Top = 336
+          Top = 332
           Width = 565
           Align = alBottom
           ResizeAnchor = akBottom
         end
         object TestTree: TTreeView
           Left = 6
-          Height = 324
+          Height = 320
           Top = 6
           Width = 553
           Align = alClient
           BorderSpacing.Around = 6
           BackgroundColor = clBtnFace
           Color = clBtnFace
-          DefaultItemHeight = 16
           Images = TestTreeImageList
           PopupMenu = PopupMenu3
           ReadOnly = True
@@ -403,7 +402,7 @@
         object Memo1: TMemo
           Left = 6
           Height = 121
-          Top = 347
+          Top = 343
           Width = 553
           Align = alBottom
           BorderSpacing.Around = 6
@@ -436,7 +435,7 @@
           TabOrder = 0
           BookMarkOptions.Xoffset = -18
           Gutter.Visible = False
-          Gutter.Width = 59
+          Gutter.Width = 61
           Gutter.MouseActions = <          
             item
               ClickCount = ccAny
@@ -882,7 +881,7 @@
               MouseActions = <>
             end
             object TSynGutterLineNumber
-              Width = 19
+              Width = 21
               MouseActions = <>
               MarkupInfo.Background = clBtnFace
               MarkupInfo.Foreground = clNone
@@ -1850,16 +1849,22 @@
     top = 176
     object RunAction: TAction
       Category = 'Run'
-      Caption = '  &Run'
+      Caption = '&Run'
       Hint = 'Run all checked test(s)'
       ImageIndex = 3
       OnExecute = RunExecute
+      SecondaryShortCuts.Strings = (
+        'F9'
+      )
       ShortCut = 16466
     end
     object ActCloseForm: TAction
       Caption = 'Quit'
       Hint = 'Quit Testing'
       OnExecute = ActCloseFormExecute
+      SecondaryShortCuts.Strings = (
+        'Esc'
+      )
       ShortCut = 16451
     end
     object actCopyErrorMsg: TAction
@@ -1897,6 +1902,7 @@
       ImageIndex = 4
       OnExecute = ActRunHighlightedTestExecute
       OnUpdate = ActRunHighLightedTestUpdate
+      ShortCut = 119
     end
   end
   object PopupMenu3: TPopupMenu
@@ -1905,7 +1911,8 @@
     top = 240
     object miRunTest: TMenuItem
       Action = RunAction
-      Caption = '  &Run all selected (checked) tests'
+      Caption = '&Run all selected (checked) tests'
+      ShortCutKey2 = 120
       OnClick = RunExecute
     end
     object MenuItem4: TMenuItem
    end
     object MenuItem4: TMenuItem

--- /cygdrive/C/lazarus/components/fpcunit/guitestrunner.pas	2014-05-06 23:52:07.524235000 +0200
+++ guitestrunner.pas	2015-04-02 15:32:08.201225600 +0200
@@ -117,6 +117,8 @@
     testSuite: TTest;
     procedure BuildTree(rootNode: TTreeNode; aSuite: TTestSuite);
     function  FindNode(aTest: TTest): TTreeNode;
+    function GetConfFileName: string;
+    function MakeTestPath(Node: TTreeNode): string;
     procedure ResetNodeColors;
     procedure PaintNodeError(aNode: TTreeNode);
     procedure PaintNodeFailure(aNode: TTreeNode);
@@ -125,6 +127,8 @@
     procedure PaintNodeBusy(aNode: TTreeNode);
     procedure MemoLog(LogEntry: string);
     procedure EnableRunActions(AValue: boolean);
+    procedure RestoreTree;
+    procedure SaveTree;
   public
     procedure AddFailure(ATest: TTest; AFailure: TTestFailure);
     procedure AddError(ATest: TTest; AError: TTestFailure);
@@ -169,7 +173,7 @@
   sactCheckAll = 'Check all Tests';
   sactUncheckAll = 'Uncheck all tests';
   sactRunHighlightedTest = 'Run highlighted test';
-  smiRunTest = '  &Run all selected (checked) tests';
+  smiRunTest = '&Run all selected (checked) tests';
   smiShowfail= 'Copy message to clipboard';
   smiCopy = '&Copy';
   smiCut = 'C&ut';
@@ -180,8 +184,10 @@
 {$R *.lfm}
 
 uses
+  IniFiles,
   xmlwrite
   ;
+
 const
   // TestTreeImageList indexes:
   imgGreenBall = 0; //success result
@@ -232,12 +238,59 @@
   XMLSynEdit.Lines.Clear;
 end;
 
+function TGUITestRunner.GetConfFileName: string;
+begin
+  Result := ParamStr(0) + '.fpcunit.ini';
+end;
+
+function TGUITestRunner.MakeTestPath(Node: TTreeNode): string;
+begin
+  Result := '';
+  while Node <> nil do
+  begin
+    Result := Node.Text + '_' + Result;
+    Node := Node.Parent;
+  end;
+end;
+
+procedure TGUITestRunner.SaveTree;
+var
+  Conf: TIniFile;
+  i: integer;
+begin
+  Conf := TIniFile.Create(GetConfFileName);
+  try
+    for i := 0 to TestTree.Items.Count - 1 do
+      Conf.WriteBool('Tests', MakeTestPath(TestTree.Items[i]), TestTree.Items[i].StateIndex = Ord(tsChecked));
+  finally
+    Conf.Free;
+  end;
+end;
+
+procedure TGUITestRunner.RestoreTree;
+var
+  Conf: TIniFile;
+  i: integer;
+begin
+  Conf := TIniFile.Create(GetConfFileName);
+  try
+    for i := 0 to TestTree.Items.Count - 1 do
+      if Conf.ReadBool('Tests', MakeTestPath(TestTree.Items[i]), true) then
+        TestTree.Items[i].StateIndex := Ord(tsChecked)
+      else
+        TestTree.Items[i].StateIndex := Ord(tsUnChecked);
+  finally
+    Conf.Free;
+  end;
+end;
+
 procedure TGUITestRunner.GUITestRunnerCreate(Sender: TObject);
 begin
   barColor := clGreen;
   TestTree.Items.Clear;
   BuildTree(TestTree.Items.AddObject(nil, rsAllTests, GetTestRegistry),
     GetTestRegistry);
+  RestoreTree;
   PageControl1.ActivePage := tsTestTree;
   //
   BtnRun.Caption:= sbtnRun;
@@ -780,6 +833,7 @@
   m: TMemoryStream;
 
 begin
+  SaveTree;
   barcolor := clGreen;
   ResetNodeColors;
   failureCounter := 0;
ResetNodeColors;
   failureCounter := 0;

{
  Copyright (C) 2004-2015 Dean Zobec, contributors

  This library is free software; you can redistribute it and/or modify it
  under the terms of the GNU Library General Public License as published by
  the Free Software Foundation; either version 2 of the License, or (at your
  option) any later version.

  This program is distributed in the hope that it will be useful, but WITHOUT
  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
  for more details.

  You should have received a copy of the GNU Library General Public License
  along with this library; if not, write to the Free Software Foundation,
  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  
  
  Modified:
    Graeme Geldenhuys <graemeg@gmail.com>
    Darius Blaszijk <dhkblaszyk@zeelandnet.nl>
    Reinier Olislagers <reinierolislagers@gmail.com>
    Serguei Tarassov <serge@arbinada.com>
}

unit GuiTestRunner;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
  ExtCtrls, Buttons, ComCtrls, ActnList, Menus, Clipbrd, StdCtrls,
  testdecorator, xmltestreport,
  fpcunit, testregistry, SynEdit, SynHighlighterXML, gettext, Translations,
  inifiles;

type

  { TGUITestRunner }

  TGUITestRunner = class(TForm, ITestListener)
    actCopy: TAction;
    actCut: TAction;
    ActCloseForm: TAction;
    actCopyErrorMsg: TAction;
    ActCheckCurrentSuite: TAction;
    ActCheckAll: TAction;
    ActRunHighlightedTest: TAction;
    ActUncheckAll: TAction;
    ActUncheckCurrentSuite: TAction;
    btnRunHighlighted: TBitBtn;
    ilNodeStates: TImageList;
    Memo1: TMemo;
    MenuItem4: TMenuItem;
    MenuItem5: TMenuItem;
    MenuItem6: TMenuItem;
    MenuItem7: TMenuItem;
    MenuItem8: TMenuItem;
    miRunTest: TMenuItem;
    miShowfailureMsg: TMenuItem;
    pbBar: TPaintBox;
    PopupMenu3: TPopupMenu;
    RunAction: TAction;
    ActionList1: TActionList;
    ActionList2: TActionList;
    BtnRun: TBitBtn;
    BtnClose: TBitBtn;
    TestTreeImageList: TImageList;
    ResultsXMLImageList: TImageList;
    MenuItem1: TMenuItem;
    MenuItem2: TMenuItem;
    MenuItem3: TMenuItem;
    PopupMenu1: TPopupMenu;
    PopupMenu2: TPopupMenu;
    SaveDialog: TSaveDialog;
    Splitter1: TSplitter;
    TestTree: TTreeView;
    SynXMLSyn1: TSynXMLSyn;
    PageControl1: TPageControl;
    Panel1: TPanel;
    Panel2: TPanel;
    XMLToolBar: TToolBar;
    CopyXMLToolButton: TToolButton;
    CutXMLToolButton: TToolButton;
    SaveAsToolButton: TToolButton;
    tsTestTree: TTabSheet;
    tsResultsXML: TTabSheet;
    XMLSynEdit: TSynEdit;
    procedure ActCheckAllExecute(Sender: TObject);
    procedure ActCheckCurrentSuiteExecute(Sender: TObject);
    procedure ActCloseFormExecute(Sender: TObject);
    procedure ActRunHighlightedTestExecute(Sender: TObject);
    procedure ActUncheckAllExecute(Sender: TObject);
    procedure ActRunHighLightedTestUpdate(Sender: TObject);
    procedure ActUncheckCurrentSuiteExecute(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure RunExecute(Sender: TObject);
    procedure GUITestRunnerCreate(Sender: TObject);
    procedure GUITestRunnerShow(Sender: TObject);
    procedure MenuItem3Click(Sender: TObject);
    procedure SaveAsToolButtonClick(Sender: TObject);
    procedure TestTreeCreateNodeClass(Sender: TCustomTreeView;
      var NodeClass: TTreeNodeClass);
    procedure TestTreeMouseDown(Sender: TOBject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure TestTreeSelectionChanged(Sender: TObject);
    procedure actCopyErrorMsgExecute(Sender: TObject);
    procedure actCopyErrorMsgUpdate(Sender: TObject);
    procedure pbBarPaint(Sender: TObject);
    procedure actCopyExecute(Sender: TObject);
    procedure actCutExecute(Sender: TObject);
  private
    failureCounter: Integer;
    errorCounter: Integer;
    testsCounter: Integer;
    skipsCounter: Integer;
    barColor: TColor;
    testSuite: TTest;
    FFirstFailure: TTreeNode; // reference to first failed test
    FINI: TINIFile;
    procedure BuildTree(rootNode: TTreeNode; aSuite: TTestSuite);
    function  FindNode(aTest: TTest): TTreeNode;
    function MakeTestPath(Node: TTreeNode): string;
    procedure ResetNodeColors;
    procedure PaintNodeError(aNode: TTreeNode);
    procedure PaintNodeFailure(aNode: TTreeNode);
    procedure PaintNodeIgnore(aNode: TTreeNode);
    procedure PaintNodeNonFailed(aNode: TTreeNode);
    procedure PaintNodeBusy(aNode: TTreeNode);
    procedure MemoLog(LogEntry: string);
    procedure EnableRunActions(AValue: boolean);
    procedure RestoreTree;
    procedure SaveTree;
  public
    procedure AddFailure(ATest: TTest; AFailure: TTestFailure);
    procedure AddError(ATest: TTest; AError: TTestFailure);
    procedure StartTest(ATest: TTest);
    procedure EndTest(ATest: TTest);
    procedure RunTest(ATest: TTest);
    procedure StartTestSuite(ATestSuite: TTestSuite);
    procedure EndTestSuite(ATestSuite: TTestSuite);
  end;

var
  TestRunner: TGUITestRunner;

resourcestring
  rsAllTests = 'All Tests';
  rsRun = 'Run ';
  rsRuns = 'Runs: %s/%s';
  rsErrors = '%s    Errors: %s';
  rsFailures = '%s     Failures: %s';
  rsMessage = 'Message: %s';
  rsException = 'Exception: %s';
  rsExceptionMes = 'Exception message: %s';
  rsExceptionCla = 'Exception class: %s';
  rsUnitName = 'Unit name: %s';
  rsMethodName = 'Method name: %s';
  rsLineNumber = 'Line number: %s';
  rsRunning = 'Running %s';
  rsNumberOfExec = 'Number of executed tests: %s  Time elapsed: %s';
  // Visual components captions
  sfrmGUITest = 'FPCUnit - run unit test';
  sbtnRun = 'Run';
  sbtnRunH = 'Run highlighted test';
  sbtnClose = 'Close';
  stshTree = 'Testcase tree';
  stshResults = 'Results XML';
  sactRunAction = '&Run';
  sactRunActionH = 'Run all checked test(s)';
  sactCloseForm = 'Quit';
  sactCloseFormH = 'Quit Testting';
  sactCheckCurrentSuite = 'Check the Current Suite';
  sactUncheckCurrentSuite = 'Uncheck the Current Suite';
  sactCheckAll = 'Check all Tests';
  sactUncheckAll = 'Uncheck all tests';
  sactRunHighlightedTest = 'Run highlighted test';
  smiRunTest = '&Run all selected (checked) tests';
  smiShowfail= 'Copy message to clipboard';
  smiCopy = '&Copy';
  smiCut = 'C&ut';
  smiCopyClipbrd = 'Copy to clipboard';

implementation

{$R *.lfm}

uses
  xmlwrite
  ;

const
  // TestTreeImageList indexes:
  imgGreenBall = 0; //success result
  imgRedBall = 2;
  imgPurpleBall = 3;
  imgWarningSign = 4; //failure result
  imgInfoSign = 11; //error result
  imgGrayBall = 12; //default
  imgBlueBall = 13; //busy

type

  TTreeNodeState=(tsUnChecked, tsChecked);

type

  { TMessageTreeNode }

  TMessageTreeNode = class(TTreeNode)
  private
    FMessage: string;
  public
    property Message: string read FMessage write FMessage;
  end;

function FirstLine(const s: string): string;
var
  NewLinePos: integer;
begin
  NewLinePos := pos(LineEnding, s);
  if NewLinePos > 0 then
    Result := copy(s, 1, NewLinePos-1)
  else
    Result := s;
end;

{ TGUITestRunner }

procedure TGUITestRunner.actCopyExecute(Sender: TObject);
begin
  Clipboard.AsText := XMLSynEdit.Lines.Text;
end;


procedure TGUITestRunner.actCutExecute(Sender: TObject);
begin
  Clipboard.AsText := XMLSynEdit.Lines.Text;
  XMLSynEdit.Lines.Clear;
end;

function TGUITestRunner.MakeTestPath(Node: TTreeNode): string;
begin
  Result := '';
  while Node <> nil do
  begin
    Result := Node.Text + '_' + Result;
    Node := Node.Parent;
  end;
end;

procedure TGUITestRunner.SaveTree;
var
  i: integer;
begin
  for i := 0 to TestTree.Items.Count - 1 do
    FINI.WriteBool('Tests', MakeTestPath(TestTree.Items[i]), TestTree.Items[i].StateIndex = Ord(tsChecked));
end;

procedure TGUITestRunner.RestoreTree;
var
  i: integer;
begin
  for i := 0 to TestTree.Items.Count - 1 do
    if FINI.ReadBool('Tests', MakeTestPath(TestTree.Items[i]), true) then
      TestTree.Items[i].StateIndex := Ord(tsChecked)
    else
      TestTree.Items[i].StateIndex := Ord(tsUnChecked);
end;

procedure TGUITestRunner.GUITestRunnerCreate(Sender: TObject);
begin
  barColor := clGreen;
  TestTree.Items.Clear;
  BuildTree(TestTree.Items.AddObject(nil, rsAllTests, GetTestRegistry),
    GetTestRegistry);
  RestoreTree;
  PageControl1.ActivePage := tsTestTree;
  //
  BtnRun.Caption:= sbtnRun;
  btnRunHighlighted.Caption := sbtnRunH;
  BtnClose.Caption:= sbtnClose;
  tsTestTree.Caption:= stshTree;
  tsResultsXML.Caption:= stshResults;
  //
  Caption:= sfrmGUITest;
  RunAction.Caption:= sactRunAction;
  RunAction.Hint:= sactRunActionH;
  ActCloseForm.Caption:= sactCloseForm;
  ActCloseForm.Hint:= sactCloseFormH;
  ActCheckCurrentSuite.Caption:= sactCheckCurrentSuite;
  ActUncheckCurrentSuite.Caption:= sactUncheckCurrentSuite;
  ActCheckAll.Caption:= sactCheckAll;
  ActUncheckAll.Caption:= sactUncheckAll;
  ActRunHighlightedTest.Caption:= sactRunHighlightedTest;
  miRunTest.Caption:= smiRunTest;
  miShowfailureMsg.Caption:= smiShowfail;
  MenuItem1.Caption:= smiCopy;
  MenuItem2.Caption:= smiCut;
  MenuItem3.Caption:= smiCopyClipbrd;
  // Select the first entry in the tree in order to immediately activate the 
  // Run All tests button:
  if TestTree.Items.Count>0 then begin
    TestTree.Items.SelectOnlyThis(TestTree.Items[0]);
    TestTree.Items[0].Expand(False);
  end;

  FINI := TINIFile.Create(ExtractFileNameOnly(ParamStr(0)) + '.fpcunit.ini'); // Prevent ini file names conflict if tests are embedded in application
end;

procedure TGUITestRunner.RunExecute(Sender: TObject);
begin
  FFirstFailure := nil;
  testSuite := GetTestRegistry;
  TestTree.Selected := TestTree.Items[0];
  RunTest(testSuite);
end;

procedure TGUITestRunner.ActCloseFormExecute(Sender: TObject);
begin
  Close;
end;

procedure TGUITestRunner.ActCheckAllExecute(Sender: TObject);
var
  i: integer;
begin
  for i := 0 to TestTree.Items.Count -1 do
    TestTree.Items[i].StateIndex := ord(tsChecked);
end;

procedure TGUITestRunner.ActCheckCurrentSuiteExecute(Sender: TObject);
var
  i: integer;
begin
  if (TestTree.Selected <> nil) and (TestTree.Selected.Data <> nil) then
  begin
    TestTree.Selected.StateIndex := ord(tsChecked);
    for i := 0 to TestTree.Selected.Count - 1 do
      TestTree.Selected.Items[i].StateIndex := ord(tsChecked);
  end;
end;

procedure TGUITestRunner.ActRunHighlightedTestExecute(Sender: TObject);
begin
  FFirstFailure := nil;
  if (TestTree.Selected <> nil) and (TestTree.Selected.Data <> nil) then
  begin
    testSuite := TTest(TestTree.Selected.Data);
  end;
  RunTest(testSuite);
  TestTree.MakeSelectionVisible;
end;

procedure TGUITestRunner.ActUncheckAllExecute(Sender: TObject);
var
  i: integer;
begin
  for i := 0 to TestTree.Items.Count -1 do
    TestTree.Items[i].StateIndex := ord(tsUnChecked);
end;


procedure TGUITestRunner.ActRunHighLightedTestUpdate(Sender: TObject);
begin
  (Sender as TAction).Enabled := ((TestTree.Selected <> nil)
    and (TestTree.Selected.Data <> nil));
end;

procedure TGUITestRunner.ActUncheckCurrentSuiteExecute(Sender: TObject);
var
  i: integer;
begin
  if (TestTree.Selected <> nil) and (TestTree.Selected.Data <> nil) then
  begin
    TestTree.Selected.StateIndex := ord(tsUnchecked);
    for i := 0 to TestTree.Selected.Count - 1 do
      TestTree.Selected.Items[i].StateIndex := ord(tsUnChecked);
  end;
end;

procedure TGUITestRunner.FormDestroy(Sender: TObject);
begin
  // store window position and size
  FINI.WriteInteger('WindowState', 'Left', Left);
  FINI.WriteInteger('WindowState', 'Top', Top);
  FINI.WriteInteger('WindowState', 'Width', Width);
  FINI.WriteInteger('WindowState', 'Height', Height);
  FINI.Free;
end;

procedure TGUITestRunner.GUITestRunnerShow(Sender: TObject);
begin
  if (ParamStrUTF8(1) = '--now') or (ParamStrUTF8(1) = '-n') then
    RunExecute(Self);
  // restore last used position and size
  Left := FINI.ReadInteger('WindowState', 'Left', Left);
  Top := FINI.ReadInteger('WindowState', 'Top', Top);
  Width := FINI.ReadInteger('WindowState', 'Width', Width);
  Height := FINI.ReadInteger('WindowState', 'Height', Height);
end;

procedure TGUITestRunner.MenuItem3Click(Sender: TObject);
begin
  Clipboard.AsText := Memo1.Lines.Text;
end;

procedure TGUITestRunner.SaveAsToolButtonClick(Sender: TObject);
begin
  if SaveDialog.Execute then
    XMLSynEdit.Lines.SaveToFile(SaveDialog.FileName);
end;

procedure TGUITestRunner.TestTreeCreateNodeClass(Sender: TCustomTreeView;
  var NodeClass: TTreeNodeClass);
begin
  NodeClass := TMessageTreeNode;
end;

procedure TGUITestRunner.TestTreeMouseDown(Sender: TOBject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

  procedure ChangeCheck(aNode: TTreeNode; aCheck: TTreeNodeState);
  var
    i: integer;
    n: TTreeNode;
  begin
    if Assigned(aNode) then
    begin
      aNode.StateIndex := ord(aCheck);
      if (TTest(aNode.Data) is TTestSuite) then
        for i := 0 to aNode.Count - 1 do
        begin
          n := aNode.Items[i];
          ChangeCheck(n, aCheck);
        end;
    end;
  end;

var
  ht: THitTests;
  lNode: TTreeNode;
begin
  ht := (Sender as TTreeview).GetHitTestInfoAt(X, Y);
  if htOnStateIcon in ht then
  begin
    lNode := (Sender as TTreeview).GetNodeAt(X, Y);
    case lNode.StateIndex of
        0: ChangeCheck(lNode, tsChecked);
        1: ChangeCheck(lNode, tsUnChecked);
      end;
   end;
end;


procedure TGUITestRunner.TestTreeSelectionChanged(Sender: TObject);
begin
  if ((Sender as TTreeView).Selected <> nil) and
    Assigned((Sender as TTreeview).Selected.Data)  then
  begin
    btnRunHighlighted.Visible := true;
    btnRunHighlighted.Caption := rsRun + (Sender as TTreeview).Selected.Text;
  end
  else
    begin
      btnRunHighlighted.Visible := false;
      btnRunHighlighted.Caption := '';
    end;
end;


procedure TGUITestRunner.actCopyErrorMsgExecute(Sender: TObject);
begin
  ClipBoard.AsText := (TestTree.Selected as TMessageTreeNode).Message;
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;
  alltests: integer;
  OldStyle: TBrushStyle;
begin
  with (Sender as TPaintBox) do
  begin
    Canvas.Lock;
    Canvas.Brush.Color := clSilver;
    Canvas.Rectangle(0, 0, Width, Height);
    Canvas.Font.Color := clWhite;
    if Assigned(TestSuite) then
    begin
      alltests := TestSuite.CountTestCases;
      if alltests - skipsCounter <> 0 then
      begin
        if FailureCounter + ErrorCounter = 0 then
          barColor := clGreen;
        Canvas.Brush.Color := barColor;
        Canvas.Rectangle(0, 0, round(TestsCounter / (alltests - skipsCounter) * Width), Height);
        msg := Format(rsRuns, [IntToStr(TestsCounter), IntToStr(alltests -
          skipsCounter)]);
        msg := Format(rsErrors, [msg, IntToStr(ErrorCounter)]);
        msg := Format(rsFailures, [msg, IntToStr(FailureCounter)]);
        OldStyle := Canvas.Brush.Style;
        Canvas.Brush.Style := bsClear;
        Canvas.Textout(10, 10,  msg);
        Canvas.Brush.Style := OldStyle;
      end;
    end;
    Canvas.UnLock;
  end;
end;


procedure TGUITestRunner.BuildTree(rootNode: TTreeNode; aSuite: TTestSuite);
var
  node: TTreeNode;
  i: integer;
begin
  rootNode.StateIndex := Ord(tsChecked);
  for i := 0 to ASuite.Tests.Count - 1 do
  begin
    node := TestTree.Items.AddChildObject(rootNode, ASuite.Test[i].TestName, ASuite.Test[i]);
    if ASuite.Test[i] is TTestSuite then
      BuildTree(Node, TTestSuite(ASuite.Test[i]))
    else
      if TObject(ASuite.Test[i]).InheritsFrom(TTestDecorator) then
        BuildTree(Node, TTestSuite(TTestDecorator(ASuite.Test[i]).Test));
    node.ImageIndex := imgGrayBall;
    node.SelectedIndex := imgGrayBall;
    node.StateIndex := ord(tsChecked);
  end;
  ResetNodeColors;
end;


function TGUITestRunner.FindNode(aTest: TTest): TTreeNode;
var
  i: integer;
begin
  Result := nil;
  for i := 0 to TestTree.Items.Count -1 do
    if (TTest(TestTree.Items[i].data) = aTest) then
    begin
      Result :=  TestTree.Items[i];
      Exit;
    end;
end;


procedure TGUITestRunner.ResetNodeColors;
var
  i: integer;
begin
  for i := 0 to TestTree.Items.Count - 1 do
  begin
    TestTree.Items[i].ImageIndex := imgGrayBall;
    TestTree.Items[i].SelectedIndex := imgGrayBall;
  end;
end;


procedure TGUITestRunner.PaintNodeError(aNode: TTreeNode);
begin
  while Assigned(aNode) do
  begin
    aNode.ImageIndex := imgRedBall;
    aNode.SelectedIndex := imgRedBall;
    if aNode.AbsoluteIndex<>0 then begin
      aNode.Expand(True);
    end;
    aNode := aNode.Parent;
    if Assigned(aNode) and
      ((aNode.ImageIndex in [imgGreenBall, imgPurpleBall, imgGrayBall, imgBlueBall]) or
      (ANode.ImageIndex = -1)) then
      PaintNodeError(aNode);
  end;
end;


procedure TGUITestRunner.PaintNodeFailure(aNode: TTreeNode);
begin
  while Assigned(aNode) do
  begin
    if ((aNode.ImageIndex in [imgGreenBall, imgGrayBall, imgBlueBall]) or
      (ANode.ImageIndex = -1)) then
    begin
      aNode.ImageIndex := imgPurpleBall;
      aNode.SelectedIndex := imgPurpleBall;
      if aNode.AbsoluteIndex<>0 then begin
        aNode.Expand(true);
      end;
    end;
    aNode := aNode.Parent;
    if Assigned(aNode) and ((aNode.ImageIndex in [imgGreenBall, imgGrayBall, imgBlueBall]) or
      (ANode.ImageIndex = -1)) then
      PaintNodeFailure(aNode);
  end;
end;

procedure TGUITestRunner.PaintNodeIgnore(aNode: TTreeNode);
// Test results with Ignore
var
  noFailedSibling: boolean;
  i: integer;
begin
  if Assigned(aNode) then
  begin
    if ((aNode.ImageIndex in [imgGrayBall, imgBlueBall]) or
      (ANode.ImageIndex = -1)) then
    begin
      aNode.ImageIndex := imgGreenBall;
      aNode.SelectedIndex := imgGreenBall;
    end;
  end;
  if Assigned(aNode.Parent) then
    if aNode.Index = aNode.Parent.Count -1 then
    begin
    aNode := aNode.Parent;
    noFailedSibling := true;
    for i := 0 to aNode.Count -2 do
    begin
      if aNode.Items[i].ImageIndex <> imgGreenBall then
        noFailedSibling := false;;
    end;
    if (aNode.ImageIndex = imgBlueBall) and
      noFailedSibling then
      PaintNodeIgnore(aNode);
    end;
end;


procedure TGUITestRunner.PaintNodeNonFailed(aNode: TTreeNode);
var
  noFailedSibling: boolean;
  i: integer;
begin
  if Assigned(aNode) then
  begin
    if ((aNode.ImageIndex in [imgGrayBall, imgBlueBall]) or
      (ANode.ImageIndex = -1)) then
    begin
      aNode.ImageIndex := imgGreenBall;
      aNode.SelectedIndex := imgGreenBall;
    end;
  end;
  if Assigned(aNode.Parent) then
    if aNode.Index = aNode.Parent.Count -1 then
    begin
    aNode := aNode.Parent;
    noFailedSibling := true;
    for i := 0 to aNode.Count -2 do
    begin
      if aNode.Items[i].ImageIndex <> imgGreenBall then
        noFailedSibling := false;;
    end;
    if (aNode.ImageIndex = imgBlueBall) 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 := imgBlueBall;
    aNode.SelectedIndex := imgBlueBall;
  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 <> imgGreenBall then
          BusySibling := false;;
      end;
      if (aNode.ImageIndex = imgBlueBall) and
        BusySibling then
        PaintNodeBusy(aNode);
    end;
  end;
end;


procedure TGUITestRunner.MemoLog(LogEntry: string);
begin
  Memo1.Lines.Add(TimeToStr(Now) + ' - ' + LogEntry);
end;

procedure TGUITestRunner.EnableRunActions(AValue: boolean);
begin
  ActRunHighlightedTest.Enabled := AValue;
  RunAction.Enabled := AValue;
end;

procedure TGUITestRunner.AddFailure(ATest: TTest; AFailure: TTestFailure);
var
  FailureNode: TTreeNode;
  node: TMessageTreeNode;
begin
  FailureNode := FindNode(ATest);
  if Assigned(FailureNode) then
  begin
    node := TestTree.Items.AddChild(FailureNode,
      Format(rsMessage, [FirstLine(AFailure.ExceptionMessage)]))
      as TMessageTreeNode;
    if not(AFailure.IsIgnoredTest) then
    begin
      // Genuine failure
      if not Assigned(FFirstFailure) then
        FFirstFailure := FailureNode;
      node.Message := AFailure.ExceptionMessage;
      node.ImageIndex := imgWarningSign;
      node.SelectedIndex := imgWarningSign;
      node := TestTree.Items.AddChild(FailureNode,
        Format(rsException, [AFailure.ExceptionClassName])) as TMessageTreeNode;
      node.ImageIndex := imgWarningSign;
      node.SelectedIndex := imgWarningSign;
      node := TestTree.Items.AddChild(FailureNode,
        Format('at line %d in <%s>', [AFailure.LineNumber, AFailure.UnitName])) as TMessageTreeNode;
      node.ImageIndex := imgWarningSign;
      node.SelectedIndex := imgWarningSign;
      PaintNodeFailure(FailureNode);
    end
    else
    begin
      // Although reported as a failure, the test was set up
      // to be ignored so it is actually a success of sorts
      node.Message := AFailure.ExceptionMessage;
      node.ImageIndex := imgGreenBall;
      node.SelectedIndex := imgGreenBall;
      node := TestTree.Items.AddChild(FailureNode,
        Format(rsException, [AFailure.ExceptionClassName])) as TMessageTreeNode;
      node.ImageIndex := imgGreenBall;
      node.SelectedIndex := imgGreenBall;
      PaintNodeIgnore(FailureNode);
    end;
  end;

  if not(AFailure.IsIgnoredTest) then
  begin
    Inc(failureCounter);
    if errorCounter = 0 then
      barColor := clFuchsia;
  end;
end;


procedure TGUITestRunner.AddError(ATest: TTest; AError: TTestFailure);
var
  ErrorNode, node: TTreeNode;
  MessageNode: TMessageTreeNode;
begin
  ErrorNode := FindNode(ATest);
  if Assigned(ErrorNode) then
  begin
    if not Assigned(FFirstFailure) then
      FFirstFailure := ErrorNode;
    MessageNode := TestTree.Items.AddChild(ErrorNode,
      Format(rsExceptionMes, [FirstLine(AError.ExceptionMessage)]))
      as TMessageTreeNode;
    MessageNode.Message := AError.ExceptionMessage;
    MessageNode.ImageIndex := imgWarningSign;
    MessageNode.SelectedIndex := imgWarningSign;
    node := TestTree.Items.AddChild(ErrorNode, Format(rsExceptionCla, [
      AError.ExceptionClassName]));
    node.ImageIndex := imgWarningSign;
    node.SelectedIndex := imgWarningSign;
    if (AError.SourceUnitName <> '') and
      (AError.FailedMethodName <> '')
    then
    begin
      node := TestTree.Items.AddChild(ErrorNode, Format(rsUnitName, [
        AError.SourceUnitName]));
      node.ImageIndex := imgInfoSign;
      node.SelectedIndex := imgInfoSign;
      node := TestTree.Items.AddChild(ErrorNode, Format(rsMethodName, [
        AError.FailedMethodName]));
      node.ImageIndex := imgInfoSign;
      node.SelectedIndex := imgInfoSign;
      node := TestTree.Items.AddChild(ErrorNode, Format(rsLineNumber, [IntToStr(
        AError.LineNumber)]));
      node.ImageIndex := imgInfoSign;
      node.SelectedIndex := imgInfoSign;
    end;
    PaintNodeError(ErrorNode);
  end;
  Inc(errorCounter);
  barColor := clRed;
end;


procedure TGUITestRunner.StartTest(ATest: TTest);
var
  Node: TTreeNode;
begin
  TestTree.BeginUpdate;
  Node := FindNode(ATest);
  Node.DeleteChildren;
  PaintNodeBusy(Node);
  if Node.Level=1 then begin
    Node.MakeVisible;
  end;
  if assigned(Node.Parent) and (Node.Parent.Level=1) then begin
    Node.Parent.MakeVisible;
  end;
  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;
  Application.ProcessMessages;
  TestTree.EndUpdate;
end;

procedure TGUITestRunner.RunTest(ATest: TTest);
  procedure SkipUncheckedTests(aResult: TTestResult; aNode: TTreeNode);
  var
    i: integer;
  begin
    if (aNode.StateIndex = ord(tsUnChecked)) and (TTest(aNode.Data) is TTestCase) then
      aResult.AddToSkipList(TTest(aNode.Data) as TTestCase);
    for i := 0 to aNode.Count - 1 do
      SkipUncheckedTests(aResult, aNode.Items[i]);
  end;

var
  TestResult:TTestResult;
  w: TXMLResultsWriter;
  m: TMemoryStream;

begin
  SaveTree;
  barcolor := clGreen;
  ResetNodeColors;
  failureCounter := 0;
  errorCounter := 0;
  testsCounter := 0;
  skipsCounter := 0;
  EnableRunActions(false);
  TestResult := TTestResult.Create;
  try
    SkipUncheckedTests(TestResult, TestTree.Selected);
    skipsCounter := TestResult.NumberOfSkippedTests;
    TestResult.AddListener(self);
    pbBar.Invalidate;
    w := TXMLResultsWriter.Create(nil);
    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)]));

      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);

    TestResult.Free;
  end;
end;

procedure TGUITestRunner.StartTestSuite(ATestSuite: TTestSuite);
begin
  // do nothing
end;

procedure TGUITestRunner.EndTestSuite(ATestSuite: TTestSuite);
begin
  // scroll treeview to first failed test
  if Assigned(FFirstFailure) then
  begin
    TestTree.Selected := FFirstFailure;
    TestTree.MakeSelectionVisible;
  end;
end;

procedure TranslateResStrings;
var
  Lang, FallbackLang, S: String;

begin
  GetLanguageIDs(Lang,FallbackLang); // in unit gettext
  S:=AppendPathDelim(AppendPathDelim(ExtractFileDir(ParamStr(0))) + 'languages');
  if FallbackLang = 'pt' then
     Lang := 'pb';
  TranslateUnitResourceStrings('guitestrunner',S+'guitestrunner.%s.po', Lang,FallbackLang);
end;

initialization
  TranslateResStrings;

end.

Index: /home/serge/Projects/lazarus/trunk/components/fpcunit/guitestrunner.pas
===================================================================
--- /home/serge/Projects/lazarus/trunk/components/fpcunit/guitestrunner.pas	(revision 48679)
+++ /home/serge/Projects/lazarus/trunk/components/fpcunit/guitestrunner.pas	(working copy)
@@ -20,6 +20,7 @@
     Graeme Geldenhuys <graemeg@gmail.com>
     Darius Blaszijk <dhkblaszyk@zeelandnet.nl>
     Reinier Olislagers <reinierolislagers@gmail.com>
+    Serguei Tarassov <serge@arbinada.com>
 }
 
 unit GuiTestRunner;
@@ -121,6 +122,7 @@
     FINI: TINIFile;
     procedure BuildTree(rootNode: TTreeNode; aSuite: TTestSuite);
     function  FindNode(aTest: TTest): TTreeNode;
+    function MakeTestPath(Node: TTreeNode): string;
     procedure ResetNodeColors;
     procedure PaintNodeError(aNode: TTreeNode);
     procedure PaintNodeFailure(aNode: TTreeNode);
@@ -129,6 +131,8 @@
     procedure PaintNodeBusy(aNode: TTreeNode);
     procedure MemoLog(LogEntry: string);
     procedure EnableRunActions(AValue: boolean);
+    procedure RestoreTree;
+    procedure SaveTree;
   public
     procedure AddFailure(ATest: TTest; AFailure: TTestFailure);
     procedure AddError(ATest: TTest; AError: TTestFailure);
@@ -173,7 +177,7 @@
   sactCheckAll = 'Check all Tests';
   sactUncheckAll = 'Uncheck all tests';
   sactRunHighlightedTest = 'Run highlighted test';
-  smiRunTest = '  &Run all selected (checked) tests';
+  smiRunTest = '&Run all selected (checked) tests';
   smiShowfail= 'Copy message to clipboard';
   smiCopy = '&Copy';
   smiCut = 'C&ut';
@@ -186,6 +190,7 @@
 uses
   xmlwrite
   ;
+
 const
   // TestTreeImageList indexes:
   imgGreenBall = 0; //success result
@@ -236,12 +241,42 @@
   XMLSynEdit.Lines.Clear;
 end;
 
+function TGUITestRunner.MakeTestPath(Node: TTreeNode): string;
+begin
+  Result := '';
+  while Node <> nil do
+  begin
+    Result := Node.Text + '_' + Result;
+    Node := Node.Parent;
+  end;
+end;
+
+procedure TGUITestRunner.SaveTree;
+var
+  i: integer;
+begin
+  for i := 0 to TestTree.Items.Count - 1 do
+    FINI.WriteBool('Tests', MakeTestPath(TestTree.Items[i]), TestTree.Items[i].StateIndex = Ord(tsChecked));
+end;
+
+procedure TGUITestRunner.RestoreTree;
+var
+  i: integer;
+begin
+  for i := 0 to TestTree.Items.Count - 1 do
+    if FINI.ReadBool('Tests', MakeTestPath(TestTree.Items[i]), true) then
+      TestTree.Items[i].StateIndex := Ord(tsChecked)
+    else
+      TestTree.Items[i].StateIndex := Ord(tsUnChecked);
+end;
+
 procedure TGUITestRunner.GUITestRunnerCreate(Sender: TObject);
 begin
   barColor := clGreen;
   TestTree.Items.Clear;
   BuildTree(TestTree.Items.AddObject(nil, rsAllTests, GetTestRegistry),
     GetTestRegistry);
+  RestoreTree;
   PageControl1.ActivePage := tsTestTree;
   //
   BtnRun.Caption:= sbtnRun;
@@ -272,7 +307,7 @@
     TestTree.Items[0].Expand(False);
   end;
 
-  FINI := TINIFile.Create(ExtractFileNameOnly(ParamStr(0))+ '.ini');
+  FINI := TINIFile.Create(ExtractFileNameOnly(ParamStr(0)) + '.fpcunit.ini'); // Prevent ini file names conflict if tests are embedded in application
 end;
 
 procedure TGUITestRunner.RunExecute(Sender: TObject);
@@ -820,6 +855,7 @@
   m: TMemoryStream;
 
 begin
+  SaveTree;
   barcolor := clGreen;
   ResetNodeColors;
   failureCounter := 0;

Index: /home/serge/Projects/lazarus/trunk/components/fpcunit/guitestrunner.lfm
===================================================================
--- /home/serge/Projects/lazarus/trunk/components/fpcunit/guitestrunner.lfm	(revision 48679)
+++ /home/serge/Projects/lazarus/trunk/components/fpcunit/guitestrunner.lfm	(working copy)
@@ -1850,16 +1850,22 @@
     top = 176
     object RunAction: TAction
       Category = 'Run'
-      Caption = '  &Run'
+      Caption = '&Run'
       Hint = 'Run all checked test(s)'
       ImageIndex = 3
       OnExecute = RunExecute
+      SecondaryShortCuts.Strings = (
+        'F9'
+      )
       ShortCut = 16466
     end
     object ActCloseForm: TAction
       Caption = 'Quit'
       Hint = 'Quit Testing'
       OnExecute = ActCloseFormExecute
+      SecondaryShortCuts.Strings = (
+        'Esc'
+      )
       ShortCut = 16451
     end
     object actCopyErrorMsg: TAction
@@ -1897,6 +1903,7 @@
       ImageIndex = 4
       OnExecute = ActRunHighlightedTestExecute
       OnUpdate = ActRunHighLightedTestUpdate
+      ShortCut = 119
     end
   end
   object PopupMenu3: TPopupMenu
@@ -1905,7 +1912,8 @@
     top = 240
     object miRunTest: TMenuItem
       Action = RunAction
-      Caption = '  &Run all selected (checked) tests'
+      Caption = '&Run all selected (checked) tests'
+      ShortCutKey2 = 120
       OnClick = RunExecute
     end
     object MenuItem4: TMenuItem

Index: /home/serge/Projects/lazarus/trunk/components/fpcunit/guitestrunner.lfm
===================================================================
--- /home/serge/Projects/lazarus/trunk/components/fpcunit/guitestrunner.lfm	(revision 48684)
+++ /home/serge/Projects/lazarus/trunk/components/fpcunit/guitestrunner.lfm	(working copy)
@@ -1850,16 +1850,22 @@
     top = 176
     object RunAction: TAction
       Category = 'Run'
-      Caption = '  &Run'
+      Caption = '&Run'
       Hint = 'Run all checked test(s)'
       ImageIndex = 3
       OnExecute = RunExecute
+      SecondaryShortCuts.Strings = (
+        'F9'
+      )
       ShortCut = 16466
     end
     object ActCloseForm: TAction
       Caption = 'Quit'
       Hint = 'Quit Testing'
       OnExecute = ActCloseFormExecute
+      SecondaryShortCuts.Strings = (
+        'Esc'
+      )
       ShortCut = 16451
     end
     object actCopyErrorMsg: TAction
@@ -1897,6 +1903,7 @@
       ImageIndex = 4
       OnExecute = ActRunHighlightedTestExecute
       OnUpdate = ActRunHighLightedTestUpdate
+      ShortCut = 119
     end
   end
   object PopupMenu3: TPopupMenu
@@ -1905,7 +1912,8 @@
     top = 240
     object miRunTest: TMenuItem
       Action = RunAction
-      Caption = '  &Run all selected (checked) tests'
+      Caption = '&Run all selected (checked) tests'
+      ShortCutKey2 = 120
       OnClick = RunExecute
     end
     object MenuItem4: TMenuItem

Index: /home/serge/Projects/lazarus/trunk/components/fpcunit/guitestrunner.pas
===================================================================
--- /home/serge/Projects/lazarus/trunk/components/fpcunit/guitestrunner.pas	(revision 48684)
+++ /home/serge/Projects/lazarus/trunk/components/fpcunit/guitestrunner.pas	(working copy)
@@ -20,6 +20,7 @@
     Graeme Geldenhuys <graemeg@gmail.com>
     Darius Blaszijk <dhkblaszyk@zeelandnet.nl>
     Reinier Olislagers <reinierolislagers@gmail.com>
+    Serguei Tarassov <serge@arbinada.com>
 }
 
 unit GuiTestRunner;
@@ -118,9 +119,10 @@
     barColor: TColor;
     testSuite: TTest;
     FFirstFailure: TTreeNode; // reference to first failed test
-    FINI: TINIFile;
+    FConfStore: TIniFile;
     procedure BuildTree(rootNode: TTreeNode; aSuite: TTestSuite);
     function  FindNode(aTest: TTest): TTreeNode;
+    function MakeTestPath(Node: TTreeNode): string;
     procedure ResetNodeColors;
     procedure PaintNodeError(aNode: TTreeNode);
     procedure PaintNodeFailure(aNode: TTreeNode);
@@ -129,6 +131,8 @@
     procedure PaintNodeBusy(aNode: TTreeNode);
     procedure MemoLog(LogEntry: string);
     procedure EnableRunActions(AValue: boolean);
+    procedure RestoreTree;
+    procedure SaveTree;
   public
     procedure AddFailure(ATest: TTest; AFailure: TTestFailure);
     procedure AddError(ATest: TTest; AError: TTestFailure);
@@ -173,7 +177,7 @@
   sactCheckAll = 'Check all Tests';
   sactUncheckAll = 'Uncheck all tests';
   sactRunHighlightedTest = 'Run highlighted test';
-  smiRunTest = '  &Run all selected (checked) tests';
+  smiRunTest = '&Run all selected (checked) tests';
   smiShowfail= 'Copy message to clipboard';
   smiCopy = '&Copy';
   smiCut = 'C&ut';
@@ -186,6 +190,7 @@
 uses
   xmlwrite
   ;
+
 const
   // TestTreeImageList indexes:
   imgGreenBall = 0; //success result
@@ -236,12 +241,43 @@
   XMLSynEdit.Lines.Clear;
 end;
 
+function TGUITestRunner.MakeTestPath(Node: TTreeNode): string;
+begin
+  Result := '';
+  while Node <> nil do
+  begin
+    Result := Node.Text + '_' + Result;
+    Node := Node.Parent;
+  end;
+end;
+
+procedure TGUITestRunner.SaveTree;
+var
+  i: integer;
+begin
+  for i := 0 to TestTree.Items.Count - 1 do
+    FConfStore.WriteBool('Tests', MakeTestPath(TestTree.Items[i]), TestTree.Items[i].StateIndex = Ord(tsChecked));
+end;
+
+procedure TGUITestRunner.RestoreTree;
+var
+  i: integer;
+begin
+  for i := 0 to TestTree.Items.Count - 1 do
+    if FConfStore.ReadBool('Tests', MakeTestPath(TestTree.Items[i]), true) then
+      TestTree.Items[i].StateIndex := Ord(tsChecked)
+    else
+      TestTree.Items[i].StateIndex := Ord(tsUnChecked);
+end;
+
 procedure TGUITestRunner.GUITestRunnerCreate(Sender: TObject);
 begin
+  FConfStore := TIniFile.Create(ExtractFileNameOnly(ParamStr(0)) + '.fpcunit.ini'); // Prevent ini file names conflict if tests are embedded in application
   barColor := clGreen;
   TestTree.Items.Clear;
   BuildTree(TestTree.Items.AddObject(nil, rsAllTests, GetTestRegistry),
     GetTestRegistry);
+  RestoreTree;
   PageControl1.ActivePage := tsTestTree;
   //
   BtnRun.Caption:= sbtnRun;
@@ -271,8 +307,6 @@
     TestTree.Items.SelectOnlyThis(TestTree.Items[0]);
     TestTree.Items[0].Expand(False);
   end;
-
-  FINI := TINIFile.Create(ExtractFileNameOnly(ParamStr(0))+ '.ini');
 end;
 
 procedure TGUITestRunner.RunExecute(Sender: TObject);
@@ -349,11 +383,11 @@
 procedure TGUITestRunner.FormDestroy(Sender: TObject);
 begin
   // store window position and size
-  FINI.WriteInteger('WindowState', 'Left', Left);
-  FINI.WriteInteger('WindowState', 'Top', Top);
-  FINI.WriteInteger('WindowState', 'Width', Width);
-  FINI.WriteInteger('WindowState', 'Height', Height);
-  FINI.Free;
+  FConfStore.WriteInteger('WindowState', 'Left', Left);
+  FConfStore.WriteInteger('WindowState', 'Top', Top);
+  FConfStore.WriteInteger('WindowState', 'Width', Width);
+  FConfStore.WriteInteger('WindowState', 'Height', Height);
+  FConfStore.Free;
 end;
 
 procedure TGUITestRunner.GUITestRunnerShow(Sender: TObject);
@@ -361,10 +395,10 @@
   if (ParamStrUTF8(1) = '--now') or (ParamStrUTF8(1) = '-n') then
     RunExecute(Self);
   // restore last used position and size
-  Left := FINI.ReadInteger('WindowState', 'Left', Left);
-  Top := FINI.ReadInteger('WindowState', 'Top', Top);
-  Width := FINI.ReadInteger('WindowState', 'Width', Width);
-  Height := FINI.ReadInteger('WindowState', 'Height', Height);
+  Left := FConfStore.ReadInteger('WindowState', 'Left', Left);
+  Top := FConfStore.ReadInteger('WindowState', 'Top', Top);
+  Width := FConfStore.ReadInteger('WindowState', 'Width', Width);
+  Height := FConfStore.ReadInteger('WindowState', 'Height', Height);
 end;
 
 procedure TGUITestRunner.MenuItem3Click(Sender: TObject);
@@ -820,6 +854,7 @@
   m: TMemoryStream;
 
 begin
+  SaveTree;
   barcolor := clGreen;
   ResetNodeColors;
   failureCounter := 0;