unit frmtestinsight;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, LazFileUtils, LazUTF8, Forms, Controls,
  Graphics, Dialogs, ExtCtrls, ComCtrls, ActnList, Menus, Clipbrd, StdCtrls,
  LCLProc, AsyncProcess, IniFiles, fpJSON, testinsightprotocol,
  testinsightserver, jsonparser, types, StrUtils, strtestcaseopts;


type
  { TTestInsightForm }

  TTestInsightForm = class(TForm)
    ActCloseForm: TAction;
    ActCopyErrorMsg: TAction;
    ActCheckCurrentSuite: TAction;
    ActCheckAll: TAction;
    ActCopyTextToClipboard: TAction;
    aRefresh: TAction;
    ActRunHighlightedTest: TAction;
    ActUncheckAll: TAction;
    ActUncheckCurrentSuite: TAction;
    pTest: TAsyncProcess;
    ilNodeStates: TImageList;
    MMtestInsight: TMainMenu;
    mDetails: TMemo;
    MenuItem10: TMenuItem;
    MenuItem11: TMenuItem;
    MenuItem12: TMenuItem;
    MenuItem13: TMenuItem;
    MenuItem14: TMenuItem;
    MenuItem15: TMenuItem;
    MenuItem16: TMenuItem;
    MenuItem17: TMenuItem;
    MenuItem19: TMenuItem;
    MenuItem2: TMenuItem;
    MenuItemEdit: TMenuItem;
    MenuItem3: TMenuItem;
    MenuItemTestTree: TMenuItem;
    MenuItemActions: TMenuItem;
    miExpandNodes: TMenuItem;
    miCollapseNodes: TMenuItem;
    MenuItem4: TMenuItem;
    MenuItem5: TMenuItem;
    MenuItem6: TMenuItem;
    MenuItem7: TMenuItem;
    MenuItem8: TMenuItem;
    MenuItem9: TMenuItem;
    miRunTest: TMenuItem;
    miShowfailureMsg: TMenuItem;
    pbBar: TPaintBox;
    pmResults: TPopupMenu;
    actRunAll: TAction;
    alTestInsight: TActionList;
    sbTestInsight: TStatusBar;
    TestTree: TTreeView;
    TestTreeImageList: TImageList;
    ILMenu: TImageList;
    miRefresh: TMenuItem;
    MenuItemCopyText: TMenuItem;
    pmDetails: TPopupMenu;
    Panel1: TPanel;
    Panel2: TPanel;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    actNextError: TAction;
    MenuItem20: TMenuItem;
    actPrevError: TAction;
    MenuItem21: TMenuItem;
    MenuItem22: TMenuItem;
    MenuItem23: TMenuItem;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    procedure actNextErrorUpdate(Sender: TObject);
    procedure actPrevErrorUpdate(Sender: TObject);
    procedure actRunAllUpdate(Sender: TObject);
    procedure aRefreshExecute(Sender: TObject);
    procedure aRefreshUpdate(Sender: TObject);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure pTestReadData(Sender: TObject);
    procedure TestInsightFormCreate(Sender: TObject);
    procedure TestInsightFormDestroy(Sender: TObject);
    procedure ActCheckAllExecute(Sender: TObject);
    procedure ActCheckCurrentSuiteExecute(Sender: TObject);
    procedure ActCloseFormExecute(Sender: TObject);
    procedure ActCopyTextToClipboardExecute(Sender: TObject);
    procedure ActCopyTextToClipboardUpdate(Sender: TObject);
    procedure ActRunHighlightedTestExecute(Sender: TObject);
    procedure ActUncheckAllExecute(Sender: TObject);
    procedure ActRunHighLightedTestUpdate(Sender: TObject);
    procedure ActUncheckCurrentSuiteExecute(Sender: TObject);
    procedure ActCopyErrorMsgExecute(Sender: TObject);
    procedure ActCopyErrorMsgUpdate(Sender: TObject);
    procedure actNextErrorExecute(Sender: TObject);
    procedure actPrevErrorExecute(Sender: TObject);
    procedure miCollapseNodesClick(Sender: TObject);
    procedure miExpandNodesClick(Sender: TObject);
    procedure RunAllExecute(Sender: TObject);
    procedure TestTreeChange(Sender: TObject; Node: TTreeNode);
    procedure TestTreeCreateNodeClass(Sender: TCustomTreeView; var NodeClass: TTreeNodeClass);
    procedure TestTreeDblClick(Sender: TObject);
    procedure TestTreeMouseDown(Sender: TObject; {%H-}Button: TMouseButton;
      {%H-}Shift: TShiftState; X, Y: Integer);
    procedure TestTreeSelectionChanged(Sender: TObject);
    procedure pbBarPaint(Sender: TObject);
  private
    FConfStoreFile : String;
    FTestProject : String;
    FTestCount : Integer;
    failureCounter: Integer;
    errorCounter: Integer;
    testsCounter: Integer;
    skipsCounter: Integer;
    barColor: TColor;
    FTestSuite : TTestItem;
    FSelectedTestSuite: TTestItem;
    FFirstFailure: TTreeNode; // reference to first failed test
    FServer : TTestInsightServer;
    FTestsRunning : Boolean;
    procedure AddSelected(N: TTreeNode; var Tests: TStringDynArray; var aLen: Integer);
    // Callbacks for server
    procedure DoClearTests(Sender: TObject);
    procedure DoFinishedTests(Sender: TObject);
    procedure DoGetSelectedTests(Sender: TObject; var Tests: TStringDynArray);
    procedure DoSetTestResult(Sender: TObject; aResult: TTestInsightResultArray);
    procedure DoGetOptions(Sender: TObject; aOptions: TTestInsightOptions);
    procedure DoSetTestSuite(Sender: TObject; Tests: TTestItem);
    procedure DoStartTests(Sender: TObject; aCount: Integer);
    // Tree handling
    function  FindNode(aTest: String): TTreeNode;
    function HaveErrors: Boolean;
    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 EnableRunActions(AValue: boolean);
    procedure ShowDetails(const Node: TTreeNode);
  Protected
    procedure ClearDetails;
    procedure CreateTestRunConfigFile(aConfStoreFile: string; aSendNamesOnly: Boolean);
    procedure ShowTestSuite;
    procedure RestoreTree;
    procedure SaveTree;
    procedure BuildTree(rootNode: TTreeNode; aSuite: TTestItem);
    Procedure SetFirstFailure(aNode: TTreeNode);
  public
    procedure AddFailure(aNode : TTreeNode; ATest: TTestItem);
    procedure AddError(aNode : TTreeNode; ATest: TTestItem);
    procedure StartTest(ATest: String);
    procedure EndTest(aNode : TTreeNode; ATest: TTestItem);
    procedure RunTest(ATest: TTestItem); virtual;
    procedure NextError;
    procedure PrevError;
    procedure MaybeStartTestProject;
    // test project handling. Needs to integrate with Lazarus IDE.
    function ShowRefreshTestproject : Boolean; virtual;
    function AutoFetchTests : Boolean; virtual;
    function GetBaseURL: String; virtual;
    function GetTestProject : String; virtual;
    procedure RunTestProject(aExecutable : String; SendNamesOnly : Boolean);  virtual;
    function TestRunning : Boolean; virtual;
    procedure ConfigureServer(aServer: TTestInsightServer); virtual;
    function CreateServer(aOwner : TComponent) : TTestInsightServer; virtual;
    procedure NavigateTo(const {%H-}aClass, {%H-}aMethod,{%H-}aUnit,{%H-}aLocationFile : String; {%H-}aLocationLine : Integer); virtual;
    procedure DoneServer(aServer :TTestInsightServer); virtual;
    procedure ShowMessage(aType : TInsightMessageType; Const Msg : String); virtual;
    procedure HandleServerLog(Sender: TObject; const aType : TInsightMessageType; const aMessage: String); virtual;
    Property Server : TTestInsightServer Read FServer;
  public
  end;

implementation

{$R *.lfm}

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


const
  SectionName_TestNodes = 'Tests';

type
  TTreeNodeState=(tsUnChecked, tsChecked);

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

{ TTestInsightForm }


function TTestInsightForm.MakeTestPath(Node: TTreeNode): string;
begin
  Result := Node.Text;
  Node := Node.Parent;
  If Node = Nil then Exit;
  // We can now skip the unnecessary "All Tests" text
  while Node.Parent <> nil do
  begin
    Result := Node.Text + '.' + Result;
    Node := Node.Parent;
  end;
end;


procedure TTestInsightForm.SaveTree;

  function SkipNode(const Node: TTreeNode): boolean;
  begin
    Result := Node.Data = nil;
  end;

var
  i: integer;
  NodePath  : String;
begin
  With TMemIniFile.Create(FConfStoreFile) do
    Try
      EraseSection(SectionName_TestNodes);
      for i := 0 to TestTree.Items.Count-1 do
        begin
        if SkipNode(TestTree.Items[i]) then
          continue;
        NodePath:=MakeTestPath(TestTree.Items[i]);
        WriteBool(SectionName_TestNodes,NodePath+ '.Checked',
                  TestTree.Items[i].StateIndex = Ord(tsChecked));
        WriteBool(SectionName_TestNodes,NodePath + '.Expanded',
                  TestTree.Items[i].Expanded);
        end;
      UpdateFile;
   Finally
     Free;
   end;
end;

procedure TTestInsightForm.RestoreTree;

Const
  ImgIdx : Array[Boolean] of Integer = (Ord(tsUnChecked),Ord(tsChecked));

var
  i: integer;
  NodePath : String;
  aIni : TMemIniFile;

begin
  aIni:=TMemIniFile.Create(FConfStoreFile);
  Try
    if not aIni.SectionExists(SectionName_TestNodes) then
     Exit;
    for i := 0 to TestTree.Items.Count - 1 do
     begin
     NodePath:=MakeTestPath(TestTree.Items[i]);
     With TestTree.Items[i] do
       begin
       Expanded:=aIni.ReadBool(SectionName_TestNodes, NodePath+ '.Expanded', Expanded);
       StateIndex:=ImgIdx[aIni.ReadBool(SectionName_TestNodes,NodePath+ '.Checked',True)];
       end;
     end;
  finally
    aIni.Free;
  end;
end;

procedure TTestInsightForm.ShowTestSuite;

begin
  FTestCount:=FTestSuite.CountTestCases;
  TestTree.BeginUpdate;
  try
    TestTree.Items.Clear;
    BuildTree(TestTree.Items.AddObject(nil, rsAllTests, FTestSuite), FTestSuite);
    RestoreTree;
    // 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;
  finally
    TestTree.EndUpdate;
  end;
end;

procedure TTestInsightForm.TestInsightFormCreate(Sender: TObject);
begin
  barColor := clGreen;
  TestTree.Items.Clear;

  Caption:= sfrmGUITest;
  actRunAll.Caption:= sactRunAction;
  actRunAll.Hint:= sactRunActionH;
  ActCloseForm.Caption:= sactCloseForm;
  ActCloseForm.Hint:= sactCloseFormH;
  ActCheckCurrentSuite.Caption:= sactCheckCurrentSuite;
  ActUncheckCurrentSuite.Caption:= sactUncheckCurrentSuite;
  ActCheckAll.Caption:= sactCheckAll;
  ActUncheckAll.Caption:= sactUncheckAll;
  ActRunHighlightedTest.Caption:= sactRunHighlightedTest;
  ActRunHighlightedTest.Hint := sactRunHighlightedTestH;
  MenuItemActions.Caption := smiActions;
  MenuItemTestTree.Caption := smiTestTree;
  MenuItemEdit.Caption := smiEdit;
  miCollapseNodes.Caption := smiCollapseNodes;
  miExpandNodes.Caption := smiExpandNodes;
  actNextError.Caption := rsNextError;
  actPrevError.Caption := rsPreviousError;
  ActCopyErrorMsg.Caption := sactCopyMessageToClipboard;
  ActCopyTextToClipboard.Caption := sactCopyAllToClipboard;
  ActCopyTextToClipboard.Hint := sactCopyAllToClipboardH;
  FServer:=CreateServer(Self);
  FServer.OnClearTests:=@DoClearTests;
  FServer.OnSetTestNames:=@DoSetTestSuite;
  FServer.OnTestResult:=@DoSetTestResult;
  FServer.OnGetSelectedTests:=@DoGetSelectedTests;
  FServer.OnTestsStarted:=@DoStartTests;
  FServer.OnTestsFinished:=@DoFinishedTests;
  FServer.OnLog:=@HandleServerLog;
  ConfigureServer(FServer);
  FServer.StartServer;
  MaybeStartTestProject;
end;

procedure TTestInsightForm.MaybeStartTestProject;

Var
  ProjectPath : String;

begin
  FTestProject:=GetTestProject;
  if (FTestProject<>'') then
    begin
    sbTestInsight.SimpleText:=FTestProject;
    ProjectPath:=ExtractFilePath(FTestProject);
    FConfStoreFile := ProjectPath + 'TestInsightSettings.ini';
    if AutoFetchTests then
      RunTestProject(FTestProject,True); // Get all tests
    end
  else
    sbTestInsight.SimpleText:=SNoTestProjectConfigured;

end;

procedure TTestInsightForm.ConfigureServer(aServer: TTestInsightServer);

begin
  aServer.Port:=6789;
  aServer.BasePath:='/tests';

end;

function TTestInsightForm.CreateServer(aOwner: TComponent): TTestInsightServer;
begin
  Result:=TTestInsightServer.Create(aOwner)
end;

procedure TTestInsightForm.NavigateTo(const aClass,aMethod, aUnit, aLocationFile: String; aLocationLine: Integer);
begin
  ShowMessage(imtInfo,SNavigationNotAvailable);
end;

procedure TTestInsightForm.DoneServer(aServer: TTestInsightServer);
begin
  aServer.Free;
end;

procedure TTestInsightForm.ShowMessage(aType: TInsightMessageType; const Msg: String);
begin
  Dialogs.ShowMessage(Msg);
end;


procedure TTestInsightForm.pTestReadData(Sender: TObject);

Type
  TBuffer = Array[1..4096] of byte;

Var
  Count : Integer;
  Buf : TBuffer;

begin
  Buf:=Default(TBuffer);
  // We just clear the buffer
  Count:=PTest.NumBytesAvailable;
  While Count>0 do
    Count:=Count-pTest.Output.Read(Buf,SizeOf(Buf));
end;

procedure TTestInsightForm.actRunAllUpdate(Sender: TObject);
begin
  (Sender as TAction).Enabled:=Not Self.TestRunning;
end;

function TTestInsightForm.HaveErrors : Boolean;

begin
  Result:=(failureCounter>0) or (errorCounter>0);
end;

procedure TTestInsightForm.actNextErrorUpdate(Sender: TObject);
begin
  (Sender as TAction).Enabled:=HaveErrors;
end;

procedure TTestInsightForm.actPrevErrorUpdate(Sender: TObject);
begin
  (Sender as TAction).Enabled:=HaveErrors;
end;

procedure TTestInsightForm.aRefreshExecute(Sender: TObject);
begin
  MaybeStartTestProject;
end;

procedure TTestInsightForm.aRefreshUpdate(Sender: TObject);
begin
  (Sender as TAction).Enabled:=ShowRefreshTestproject;
end;

procedure TTestInsightForm.FormClose(Sender: TObject;
  var CloseAction: TCloseAction);
begin
  CloseAction:=caFree;
  SaveTree;
end;


procedure TTestInsightForm.RunAllExecute(Sender: TObject);
begin
  FFirstFailure := nil;
  FSelectedTestSuite:=Nil;
  RunTestProject(FTestProject,False);
end;

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

procedure TTestInsightForm.ActCopyTextToClipboardExecute(Sender: TObject);
begin
  Clipboard.AsText := mDetails.Lines.Text
end;

procedure TTestInsightForm.ActCopyTextToClipboardUpdate(Sender: TObject);
begin
  TAction(Sender).Enabled := (ActiveControl = mDetails) ;
end;

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

procedure TTestInsightForm.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 TTestInsightForm.ActRunHighlightedTestExecute(Sender: TObject);

Var
  N : TTreeNode;

begin
  FFirstFailure := nil;
  N:=TestTree.Selected;
  if (N<>nil) then
    begin
    FSelectedTestSuite := TTestItem(N.Data);
    if Assigned(FSelectedTestSuite) then
      RunTest(FSelectedTestSuite);
    end;
  TestTree.MakeSelectionVisible;
end;

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


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

procedure TTestInsightForm.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 TTestInsightForm.TestInsightFormDestroy(Sender: TObject);
begin
  DoneServer(FServer);
  FreeAndNil(FTestSuite);
end;

procedure TTestInsightForm.miCollapseNodesClick(Sender: TObject);
begin
  if not Assigned(TestTree.Selected) then
    Exit;
  TestTree.Selected.Collapse(True);
end;

procedure TTestInsightForm.miExpandNodesClick(Sender: TObject);
begin
  if not Assigned(TestTree.Selected) then
    Exit;
  TestTree.Selected.Expand(True);
end;

procedure TTestInsightForm.TestTreeChange(Sender: TObject; Node: TTreeNode);
begin
  if not Assigned(Node) then
    Exit;
  //mDetails.Lines.Text := TMessageTreeNode(Node).Message;
end;

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

procedure TTestInsightForm.TestTreeDblClick(Sender: TObject);

  function ExtractMethod(aPath : string; Out aClass,aMethod: String) : Boolean;

  var
    P : integer;

  begin
    Result:=False;
    P:=RPos('.',aPath);
    if P>0 then
      begin
      aMethod:=Copy(aPath,P+1,Length(aPath)-P);
      aPath:=Copy(aPath,1,P-1);
      P:=RPos('.',aPath);
      if P>0 then
        aClass:=Copy(aPath,P+1,Length(aPath)-P)
      else
        aClass:=aPath;
      Result:=True;
      end;
  end;

var
  Itm : TTestItem;
  N : TTreeNode;
  aClass,aMethod,aUnit : String;
  aLocationFile : String;
  aLocationLine : Integer;

begin
  N:=TestTree.Selected;
  Itm:=Nil;
  While (Itm=Nil) and (N<>Nil) do
    begin
    if Assigned(N.Data) and (TObject(N.Data) is TTestItem) then
      Itm:=TTestItem(N.Data)
    else
      N:=N.Parent;
    end;
  if Not assigned(itm) then
    exit;
  if Itm.TestResult=Nil then
    begin
    If not ExtractMethod(Itm.TestPath,aClass,aMethod) then
      begin
      ShowMessage(imtInfo,Format(rsCouldNotDete, [Itm.TestPath]));
      exit;
      end;
    aUnit:='';
    aLocationFile:='';
    aLocationLine:=-1;
    end
  else
    begin
    With Itm.TestResult do
      begin
      aMethod:=TestMethodName;
      aClass:=TestClassName;
      aUnit:=TestUnitName;
      aLocationFile:=FailureSourceUnitName;
      aLocationLine:=FailureLineNumber;
      end;
    end;
  NavigateTo(aClass, aMethod,aUnit,aLocationFile,aLocationLine);
end;

procedure TTestInsightForm.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 TTestItem(aNode.Data).IsTestSuite 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 TTestInsightForm.ClearDetails;
begin
  mDetails.Lines.Clear;
end;

procedure TTestInsightForm.DoClearTests(Sender: TObject);
begin
  DoSetTestSuite(Sender,TTestItem.Create(Nil,''));
end;

procedure TTestInsightForm.DoFinishedTests(Sender: TObject);
begin
  FTestsRunning:=False;
  pbBar.Refresh;
end;

procedure TTestInsightForm.AddSelected(N: TTreeNode;
  var Tests: TStringDynArray; var aLen: Integer);

Var
  I : integer;

begin
  if Assigned(N.Data) and (TObject(N.Data) is TTestItem) then
    if (N.StateIndex=Ord(tsChecked)) then
      if TTestItem(N.Data).IsTestCase then
        begin
        Tests[aLen]:=TTestItem(N.Data).TestPath;
        Inc(aLen);
        end
      else if TTestItem(N.Data).IsTestSuite then
        For I:=0 to N.Count-1 do
          AddSelected(N.items[i],Tests,aLen);
end;

procedure TTestInsightForm.DoGetSelectedTests(Sender: TObject; var Tests: TStringDynArray);

Var
  aLen : integer;

begin
  aLen:=0;
  SetLength(Tests,TestTree.Items.Count);
  if TestTree.Items.Count>0 then
    AddSelected(TestTree.Items[0],Tests,aLen);
  SetLength(Tests,aLen);
end;

procedure TTestInsightForm.DoSetTestResult(Sender: TObject; aResult: TTestInsightResultArray);

Var
  I : Integer;
  Res : TTestInsightResult;
  Itm : TTestItem;
  N : TTreeNode;
  aName : string;

begin
  For I:=0 to Length(aResult)-1 do
    begin
    Res:=aResult[i];
    aName:=Res.TestName;
    N:=FindNode(aName);
    if N=Nil then
      Res.Free
    else
      begin
      Itm:=TTestItem(N.Data);
      Itm.TestResult:=Res;
      Case Res.TestResult of
        rtFailed : AddFailure(N,Itm);
        rtError : AddError(N,Itm);
        rtWarning : AddFailure(N,Itm);
        rtPassed : EndTest(N,Itm);
      else
        ; // 
      end;
      end;
    end;
end;

procedure TTestInsightForm.DoGetOptions(Sender: TObject;
  aOptions: TTestInsightOptions);
begin
  // Normally only called during test if server is running
  aOptions.ExecuteTests:=False;
  if Assigned(FSelectedTestSuite) then
    aOptions.TestSuite:=FSelectedTestSuite.TestPath
  else
    aOptions.TestSuite:=''
end;

procedure TTestInsightForm.DoSetTestSuite(Sender: TObject; Tests: TTestItem);
begin
  FreeAndNil(FTestSuite);
  FTestSuite:=Tests;
  ShowTestSuite;
end;

procedure TTestInsightForm.DoStartTests(Sender: TObject; aCount: Integer);
begin
  FTestsRunning:=true;
  if aCount=-1 then
    aCount:=FTestSuite.CountTestCases;
  failureCounter:=0;
  errorCounter:=0;
  testsCounter:=0;
  skipsCounter:=0;
  pbBar.Refresh;
end;

procedure TTestInsightForm.HandleServerLog(Sender: TObject; const aType: TInsightMessageType; const aMessage: String);
begin
  ShowMessage(atype,aMessage);
end;



procedure TTestInsightForm.ShowDetails(const Node: TTreeNode);

  procedure AddMessages(const Node: TTreeNode);
  begin
    if (Node is TMessageTreeNode) and (TMessageTreeNode(Node).Message <> '') then
      mDetails.Lines.Add(TMessageTreeNode(Node).Message)
    else
      mDetails.Lines.Add(Node.Text);
  end;

var
  CurrNode: TTreeNode;
begin
  ClearDetails;
  if TTestItem(Node.Data).IsTestCase then
  begin
    CurrNode := Node.GetFirstChild;
    while CurrNode <> nil do
    begin
      AddMessages(CurrNode);
      CurrNode := CurrNode.GetNextSibling;
    end;
  end
  else if Assigned(Node.Parent) and Assigned(Node.Parent.Data) and TTestItem(Node.Parent.Data).IsTestCase then
    AddMessages(Node);
end;


procedure TTestInsightForm.TestTreeSelectionChanged(Sender: TObject);
begin
  if (Sender as TTreeView).Selected <> nil then
    ShowDetails((Sender as TTreeView).Selected);
end;


procedure TTestInsightForm.ActCopyErrorMsgExecute(Sender: TObject);
begin
  ClipBoard.AsText := (TestTree.Selected as TMessageTreeNode).Message;
end;


procedure TTestInsightForm.ActCopyErrorMsgUpdate(Sender: TObject);
begin
  (Sender as TAction).Enabled := Assigned(TestTree.selected) and
    (Copy(TestTree.Selected.Text, 1, 9) = 'Message: ');
end;


procedure TTestInsightForm.pbBarPaint(Sender: TObject);

var
  msg: string;
  alltests: integer;
  OldStyle: TBrushStyle;
begin
  with (Sender as TPaintBox) do
  begin
    Canvas.Lock;
    if FTestsRunning then
      Canvas.Brush.Color := clBlue
    else
      Canvas.Brush.Color := clSilver;
    Canvas.Rectangle(0, 0, Width, Height);
    Canvas.Font.Color := clWhite;
    alltests := FTestCount;
    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, 4,  msg);
      Canvas.Brush.Style := OldStyle;
    end;
    Canvas.UnLock;
  end;
end;

procedure TTestInsightForm.actNextErrorExecute(Sender: TObject);
begin
  NextError;
end;

procedure TTestInsightForm.actPrevErrorExecute(Sender: TObject);
begin
  PrevError;
end;

procedure TTestInsightForm.BuildTree(rootNode: TTreeNode; aSuite: TTestItem);

var
  node: TTreeNode;
  i: integer;
  Itm : TTestItem;
  aName : TJSONStringType;

begin
  rootNode.StateIndex := Ord(tsChecked);
  for i := 0 to Length(ASuite.Tests) - 1 do
    begin
    itm:=ASuite.Tests[i];
    aName:=Itm.TestName;
    node := TestTree.Items.AddChildObject(rootNode, aName , itm);
    if Itm.IsTestSuite then
      BuildTree(Node, Itm);
    node.ImageIndex := imgGrayBall;
    node.SelectedIndex := imgGrayBall;
    node.StateIndex := ord(tsChecked);
    end;
  ResetNodeColors;
end;

procedure TTestInsightForm.SetFirstFailure(aNode: TTreeNode);
begin
  if FFirstFailure<>Nil then
    exit;
  FFirstFailure:=aNode;
  TestTree.Items.SelectOnlyThis(FFirstFailure);
  TestTree.MakeSelectionVisible;
end;


function TTestInsightForm.FindNode(aTest: String): TTreeNode;
var
  i: integer;
  tName : String;
begin
  Result := nil;
  for i := 0 to TestTree.Items.Count -1 do
    begin
    tName:=TTestItem(TestTree.Items[i].Data).TestPath;
    if SameText(tName,aTest) then
      Exit(TestTree.Items[i]);
    end;
end;


procedure TTestInsightForm.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 TTestInsightForm.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;
  end;
end;


procedure TTestInsightForm.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;
  end;
end;

procedure TTestInsightForm.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 TTestInsightForm.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   // is aNode the last child
    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 TTestInsightForm.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 TTestInsightForm.EnableRunActions(AValue: boolean);
begin
  ActRunHighlightedTest.Enabled := AValue;
  actRunAll.Enabled := AValue;
end;

procedure TTestInsightForm.AddFailure(aNode : TTreeNode; ATest: TTestItem);
var
  MNode: TMessageTreeNode;
  aClass,aMessage : String;

begin
  if not aTest.TestResult.TestIsIgnored then
    begin
    Inc(failureCounter);
    if errorCounter = 0 then
      barColor := clFuchsia;
    end;
  if Not Assigned(aNode) then
    exit;
  aMessage:=aTest.TestResult.TestExceptionMessage;
  aClass:=aTest.TestResult.TestExceptionClass;
  MNode := TestTree.Items.AddChild(aNode,
    Format(rsMessage, [FirstLine(aMessage)]))
    as TMessageTreeNode;
  if not aTest.TestResult.TestIsIgnored then
    begin
    // Genuine failure
    if not Assigned(FFirstFailure) then
      SetFirstFailure(aNode);
    MNode.Message := aMessage;
    MNode.ImageIndex := imgWarningSign;
    MNode.SelectedIndex := imgWarningSign;
    MNode := TestTree.Items.AddChild(aNode,
      Format(rsException, [aClass])) as TMessageTreeNode;
    MNode.ImageIndex := imgWarningSign;
    MNode.SelectedIndex := imgWarningSign;
    if (aTest.TestResult.FailureLocationInfo<>'') then
      begin
      MNode := TestTree.Items.AddChild(aNode, 'at ' + aTest.TestResult.FailureLocationInfo) as TMessageTreeNode;
      MNode.ImageIndex := imgWarningSign;
      MNode.SelectedIndex := imgWarningSign;
      PaintNodeFailure(aNode);
      end;
    end
  else
    begin
    // Although reported as a failure, the test was set up
    // to be ignored so it is actually a success of sorts
    MNode.Message := aMessage;
    MNode.ImageIndex := imgGreenBall;
    MNode.SelectedIndex := imgGreenBall;
    MNode := TestTree.Items.AddChild(aNode,
      Format(rsException, [aClass])) as TMessageTreeNode;
    MNode.ImageIndex := imgGreenBall;
    MNode.SelectedIndex := imgGreenBall;
    PaintNodeIgnore(aNode);
    end;
  ShowDetails(aNode);
end;


procedure TTestInsightForm.AddError(aNode : TTreeNode; ATest: TTestItem);

var
  MNode: TMessageTreeNode;
  aMessage, aClass,aLocation : String;

begin
  Inc(errorCounter);
  barColor := clRed;
  aMessage:=aTest.TestResult.TestExceptionMessage;
  aClass:=aTest.TestResult.TestExceptionClass;
  aLocation:=aTest.TestResult.FailureLocationInfo;
  if Not Assigned(aNode) then
    exit;
  if not Assigned(FFirstFailure) then
    SetFirstFailure(aNode);
  MNode := TestTree.Items.AddChild(aNode,
    Format(rsExceptionMes, [FirstLine(aMessage)]))
    as TMessageTreeNode;
  MNode.Message := aMessage;
  MNode.ImageIndex := imgWarningSign;
  MNode.SelectedIndex := imgWarningSign;
  MNode:=TestTree.Items.AddChild(aNode, Format(rsExceptionCla,[aClass])) as TMessageTreeNode;
  MNode.ImageIndex := imgWarningSign;
  MNode.SelectedIndex := imgWarningSign;
  if (aLocation<>'') then
     begin
     MNode := TestTree.Items.AddChild(aNode, 'at ' + aLocation) as TMessageTreeNode;
     MNode.ImageIndex := imgInfoSign;
     MNode.SelectedIndex := imgInfoSign;
     end;
  PaintNodeError(aNode);
  ShowDetails(aNode);
end;


procedure TTestInsightForm.StartTest(ATest: String);

var
  Node: TTreeNode;

begin
  TestTree.BeginUpdate;
  try
    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;
  finally
    TestTree.EndUpdate;
  end;
end;


procedure TTestInsightForm.EndTest(aNode : TTreeNode; ATest: TTestItem);
begin
  TestTree.BeginUpdate;
  try
    Inc(testsCounter);
    if not assigned(aNode) then
      Exit;
    PaintNodeNonFailed(aNode);
    pbbar.Refresh;
    Application.ProcessMessages;
  finally
    TestTree.EndUpdate;
  end;
  if aTest=Nil then;
end;

function TTestInsightForm.GetTestProject: String;

Var
  ProjectPath : String;

begin
  ProjectPath:=ExtractFilePath(ParamStr(0))+'testing'+PathDelim;
  Result:= ProjectPath + 'clienttest'; // + extension ?
end;


procedure TTestInsightForm.RunTest(ATest: TTestItem);

begin
  SaveTree;
  ClearDetails;
  barcolor := clGreen;
  ResetNodeColors;
  failureCounter := 0;
  errorCounter := 0;
  testsCounter := 0;
  skipsCounter := 0;
  EnableRunActions(false);
  FSelectedTestSuite:=aTest;
  RunTestProject(FTestProject,False);
end;

function TTestInsightForm.GetBaseURL: String;

begin
   Result:=Format('http://localhost:%d%s',[FServer.Port,FServer.BasePath])
end;

procedure TTestInsightForm.CreateTestRunConfigFile(aConfStoreFile : string; aSendNamesOnly : Boolean);


Var
  aIni:TmemIniFile;

begin
  aIni:=TmemIniFile.Create(aConfStoreFile);
  try
    aIni.WriteString(SConfig,KeyBaseURL,GetBaseURL);
    aIni.WriteBool(sConfig,keyExecuteTests,Not aSendNamesOnly);
    if FSelectedTestSuite<>nil then
      aIni.WriteString(SConfig,KeySuite,FSelectedTestSuite.TestPath)
    else
      aIni.DeleteKey(SConfig,KeySuite);
    aIni.UpdateFile;
  finally
    aIni.Free;
  end;
end;

procedure TTestInsightForm.RunTestProject(aExecutable: String; SendNamesOnly: Boolean);

begin
  if TestRunning then
     begin
     ShowMessage(imtInfo,Format('The test project %s is still running',[aExecutable]));
     Exit;
     end;
  if not FileExists(aExecutable) then
    begin
    ShowMessage(imtError,Format(SNoExecutableAvailable,[aExecutable]));
    Exit;
    end;
  CreateTestRunConfigFile(FConfStoreFile,SendNamesOnly);
  PTest.Executable:=aExecutable;
  try
    PTest.Execute;
  except
    On E : Exception do
      ShowMessage(imtError,Format('Error %s while running test project %s: %s',[E.ClassName,aExecutable,E.Message]));
  end;
  FSelectedTestSuite:=Nil;
end;

function TTestInsightForm.TestRunning: Boolean;
begin
  Result:=pTest.Running;
end;

procedure TTestInsightForm.NextError;

var
  Node: TTreeNode;

begin
  Node := TestTree.Selected;
  while Assigned(Node) do
  begin
    Node := Node.GetNext;
    if Assigned(Node)
       and (Node.ImageIndex in [imgRedBall, imgPurpleBall])
       and TTestItem(Node.Data).IsTestCase then
    begin
      TestTree.Selected := Node;
      TestTree.MakeSelectionVisible;
      Exit;
    end;
  end;
end;

procedure TTestInsightForm.PrevError;
var
  Node: TTreeNode;
begin
  Node := TestTree.Selected;
  while Assigned(Node) do
  begin
    Node := Node.GetPrev;
    if Assigned(Node) and (Node.ImageIndex in [imgRedBall, imgPurpleBall]) and
      TTestItem(Node.Data).IsTestCase then
    begin
      TestTree.Selected := Node;
      TestTree.MakeSelectionVisible;
      Exit;
    end;
  end;
end;

function TTestInsightForm.ShowRefreshTestproject: Boolean;
begin
  Result:=False;
end;

function TTestInsightForm.AutoFetchTests: Boolean;
begin
  Result:=True;
end;

end.

