mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-16 23:49:28 +02:00
fpc gui testrunner: introduced a custom tree node type, so the complete error message can be copied to the clipboard, issue #22817
git-svn-id: trunk@38560 -
This commit is contained in:
vincents
parent
74d88298c4
commit
c38cc4533e
@ -46,7 +46,7 @@ object GUITestRunner: TGUITestRunner
|
||||
OnShow = GUITestRunnerShow
|
||||
Position = poScreenCenter
|
||||
ShowHint = True
|
||||
LCLVersion = '0.9.29'
|
||||
LCLVersion = '1.1'
|
||||
object Panel1: TPanel
|
||||
Left = 0
|
||||
Height = 88
|
||||
@ -164,7 +164,6 @@ object GUITestRunner: TGUITestRunner
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000
|
||||
}
|
||||
NumGlyphs = 0
|
||||
ParentShowHint = False
|
||||
ShowHint = True
|
||||
TabOrder = 0
|
||||
@ -259,7 +258,6 @@ object GUITestRunner: TGUITestRunner
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
0000000000000000000000000000000000000000000000000000
|
||||
}
|
||||
NumGlyphs = 0
|
||||
ParentShowHint = False
|
||||
ShowHint = True
|
||||
TabOrder = 1
|
||||
@ -342,7 +340,6 @@ object GUITestRunner: TGUITestRunner
|
||||
0000000000000000000000000000000000000000000000000000000000000000
|
||||
00000000000000000000
|
||||
}
|
||||
NumGlyphs = 0
|
||||
TabOrder = 2
|
||||
end
|
||||
end
|
||||
@ -398,6 +395,7 @@ object GUITestRunner: TGUITestRunner
|
||||
ScrollBars = ssAutoBoth
|
||||
StateImages = ilNodeStates
|
||||
TabOrder = 0
|
||||
OnCreateNodeClass = TestTreeCreateNodeClass
|
||||
OnMouseDown = TestTreeMouseDown
|
||||
OnSelectionChanged = TestTreeSelectionChanged
|
||||
Options = [tvoAutoItemHeight, tvoHideSelection, tvoKeepCollapsedNodes, tvoReadOnly, tvoRightClickSelect, tvoShowButtons, tvoShowLines, tvoShowRoot, tvoToolTips]
|
||||
@ -438,53 +436,27 @@ object GUITestRunner: TGUITestRunner
|
||||
TabOrder = 0
|
||||
BookMarkOptions.Xoffset = -18
|
||||
Gutter.Visible = False
|
||||
Gutter.Width = 57
|
||||
Gutter.Width = 59
|
||||
Gutter.MouseActions = <
|
||||
item
|
||||
Shift = []
|
||||
ShiftMask = []
|
||||
Button = mbLeft
|
||||
ClickCount = ccAny
|
||||
ClickDir = cdDown
|
||||
Command = 13
|
||||
MoveCaret = False
|
||||
Option = 0
|
||||
Priority = 0
|
||||
Command = emcOnMainGutterClick
|
||||
end
|
||||
item
|
||||
Shift = []
|
||||
ShiftMask = []
|
||||
Button = mbRight
|
||||
ClickCount = ccSingle
|
||||
ClickDir = cdUp
|
||||
Command = 12
|
||||
MoveCaret = False
|
||||
Option = 0
|
||||
Priority = 0
|
||||
Command = emcContextMenu
|
||||
end>
|
||||
RightGutter.Width = 0
|
||||
RightGutter.MouseActions = <
|
||||
item
|
||||
Shift = []
|
||||
ShiftMask = []
|
||||
Button = mbLeft
|
||||
ClickCount = ccAny
|
||||
ClickDir = cdDown
|
||||
Command = 13
|
||||
MoveCaret = False
|
||||
Option = 0
|
||||
Priority = 0
|
||||
Command = emcOnMainGutterClick
|
||||
end
|
||||
item
|
||||
Shift = []
|
||||
ShiftMask = []
|
||||
Button = mbRight
|
||||
ClickCount = ccSingle
|
||||
ClickDir = cdUp
|
||||
Command = 12
|
||||
MoveCaret = False
|
||||
Option = 0
|
||||
Priority = 0
|
||||
Command = emcContextMenu
|
||||
end>
|
||||
Highlighter = SynXMLSyn1
|
||||
Keystrokes = <
|
||||
@ -810,135 +782,92 @@ object GUITestRunner: TGUITestRunner
|
||||
end>
|
||||
MouseActions = <
|
||||
item
|
||||
Shift = []
|
||||
ShiftMask = [ssShift, ssAlt]
|
||||
Button = mbLeft
|
||||
ClickCount = ccSingle
|
||||
ClickDir = cdDown
|
||||
Command = 1
|
||||
Command = emcStartSelections
|
||||
MoveCaret = True
|
||||
Option = 0
|
||||
Priority = 0
|
||||
end
|
||||
item
|
||||
Shift = [ssShift]
|
||||
ShiftMask = [ssShift, ssAlt]
|
||||
Button = mbLeft
|
||||
ClickCount = ccSingle
|
||||
ClickDir = cdDown
|
||||
Command = 1
|
||||
Command = emcStartSelections
|
||||
MoveCaret = True
|
||||
Option = 1
|
||||
Priority = 0
|
||||
end
|
||||
item
|
||||
Shift = [ssAlt]
|
||||
ShiftMask = [ssShift, ssAlt]
|
||||
Button = mbLeft
|
||||
ClickCount = ccSingle
|
||||
ClickDir = cdDown
|
||||
Command = 3
|
||||
Command = emcStartColumnSelections
|
||||
MoveCaret = True
|
||||
Option = 0
|
||||
Priority = 0
|
||||
end
|
||||
item
|
||||
Shift = [ssShift, ssAlt]
|
||||
ShiftMask = [ssShift, ssAlt]
|
||||
Button = mbLeft
|
||||
ClickCount = ccSingle
|
||||
ClickDir = cdDown
|
||||
Command = 3
|
||||
Command = emcStartColumnSelections
|
||||
MoveCaret = True
|
||||
Option = 1
|
||||
Priority = 0
|
||||
end
|
||||
item
|
||||
Shift = []
|
||||
ShiftMask = []
|
||||
Button = mbRight
|
||||
ClickCount = ccSingle
|
||||
ClickDir = cdUp
|
||||
Command = 12
|
||||
MoveCaret = False
|
||||
Option = 0
|
||||
Priority = 0
|
||||
Command = emcContextMenu
|
||||
end
|
||||
item
|
||||
Shift = []
|
||||
ShiftMask = []
|
||||
Button = mbLeft
|
||||
ClickCount = ccDouble
|
||||
ClickDir = cdDown
|
||||
Command = 6
|
||||
Command = emcSelectWord
|
||||
MoveCaret = True
|
||||
Option = 0
|
||||
Priority = 0
|
||||
end
|
||||
item
|
||||
Shift = []
|
||||
ShiftMask = []
|
||||
Button = mbLeft
|
||||
ClickCount = ccTriple
|
||||
ClickDir = cdDown
|
||||
Command = 7
|
||||
Command = emcSelectLine
|
||||
MoveCaret = True
|
||||
Option = 0
|
||||
Priority = 0
|
||||
end
|
||||
item
|
||||
Shift = []
|
||||
ShiftMask = []
|
||||
Button = mbLeft
|
||||
ClickCount = ccQuad
|
||||
ClickDir = cdDown
|
||||
Command = 8
|
||||
Command = emcSelectPara
|
||||
MoveCaret = True
|
||||
Option = 0
|
||||
Priority = 0
|
||||
end
|
||||
item
|
||||
Shift = []
|
||||
ShiftMask = []
|
||||
Button = mbMiddle
|
||||
ClickCount = ccSingle
|
||||
ClickDir = cdDown
|
||||
Command = 10
|
||||
Command = emcPasteSelection
|
||||
MoveCaret = True
|
||||
Option = 0
|
||||
Priority = 0
|
||||
end
|
||||
item
|
||||
Shift = [ssCtrl]
|
||||
ShiftMask = [ssShift, ssAlt, ssCtrl]
|
||||
Button = mbLeft
|
||||
ClickCount = ccSingle
|
||||
ClickDir = cdUp
|
||||
Command = 11
|
||||
MoveCaret = False
|
||||
Option = 0
|
||||
Priority = 0
|
||||
Command = emcMouseLink
|
||||
end>
|
||||
MouseSelActions = <
|
||||
item
|
||||
Shift = []
|
||||
ShiftMask = []
|
||||
Button = mbLeft
|
||||
ClickCount = ccSingle
|
||||
ClickDir = cdDown
|
||||
Command = 9
|
||||
MoveCaret = False
|
||||
Option = 0
|
||||
Priority = 0
|
||||
Command = emcStartDragMove
|
||||
end>
|
||||
VisibleSpecialChars = [vscSpace, vscTabAtLast]
|
||||
ReadOnly = True
|
||||
BracketHighlightStyle = sbhsBoth
|
||||
BracketMatchColor.Background = clNone
|
||||
BracketMatchColor.Foreground = clNone
|
||||
BracketMatchColor.Style = [fsBold]
|
||||
FoldedCodeColor.Background = clNone
|
||||
FoldedCodeColor.Foreground = clGray
|
||||
FoldedCodeColor.FrameColor = clGray
|
||||
MouseLinkColor.Background = clNone
|
||||
MouseLinkColor.Foreground = clBlue
|
||||
LineHighlightColor.Background = clNone
|
||||
LineHighlightColor.Foreground = clNone
|
||||
inline TSynGutterPartList
|
||||
object TSynGutterMarks
|
||||
Width = 24
|
||||
MouseActions = <>
|
||||
end
|
||||
object TSynGutterLineNumber
|
||||
Width = 17
|
||||
Width = 19
|
||||
MouseActions = <>
|
||||
MarkupInfo.Background = clBtnFace
|
||||
MarkupInfo.Foreground = clNone
|
||||
@ -949,35 +878,26 @@ object GUITestRunner: TGUITestRunner
|
||||
end
|
||||
object TSynGutterChanges
|
||||
Width = 4
|
||||
MouseActions = <>
|
||||
ModifiedColor = 59900
|
||||
SavedColor = clGreen
|
||||
end
|
||||
object TSynGutterSeparator
|
||||
Width = 2
|
||||
MouseActions = <>
|
||||
end
|
||||
object TSynGutterCodeFolding
|
||||
MouseActions = <
|
||||
item
|
||||
Shift = []
|
||||
ShiftMask = []
|
||||
Button = mbRight
|
||||
ClickCount = ccSingle
|
||||
ClickDir = cdUp
|
||||
Command = 16
|
||||
MoveCaret = False
|
||||
Option = 0
|
||||
Priority = 0
|
||||
Command = emcCodeFoldContextMenu
|
||||
end
|
||||
item
|
||||
Shift = []
|
||||
ShiftMask = [ssShift]
|
||||
Button = mbMiddle
|
||||
ClickCount = ccAny
|
||||
ClickDir = cdDown
|
||||
Command = 14
|
||||
MoveCaret = False
|
||||
Option = 0
|
||||
Priority = 0
|
||||
Command = emcCodeFoldCollaps
|
||||
end
|
||||
item
|
||||
Shift = [ssShift]
|
||||
@ -985,58 +905,36 @@ object GUITestRunner: TGUITestRunner
|
||||
Button = mbMiddle
|
||||
ClickCount = ccAny
|
||||
ClickDir = cdDown
|
||||
Command = 14
|
||||
MoveCaret = False
|
||||
Command = emcCodeFoldCollaps
|
||||
Option = 1
|
||||
Priority = 0
|
||||
end
|
||||
item
|
||||
Shift = []
|
||||
ShiftMask = []
|
||||
Button = mbLeft
|
||||
ClickCount = ccAny
|
||||
ClickDir = cdDown
|
||||
Command = 0
|
||||
MoveCaret = False
|
||||
Option = 0
|
||||
Priority = 0
|
||||
Command = emcNone
|
||||
end>
|
||||
MarkupInfo.Background = clNone
|
||||
MarkupInfo.Foreground = clGray
|
||||
MouseActionsExpanded = <
|
||||
item
|
||||
Shift = []
|
||||
ShiftMask = []
|
||||
Button = mbLeft
|
||||
ClickCount = ccAny
|
||||
ClickDir = cdDown
|
||||
Command = 14
|
||||
MoveCaret = False
|
||||
Option = 0
|
||||
Priority = 0
|
||||
Command = emcCodeFoldCollaps
|
||||
end>
|
||||
MouseActionsCollapsed = <
|
||||
item
|
||||
Shift = [ssCtrl]
|
||||
ShiftMask = [ssCtrl]
|
||||
Button = mbLeft
|
||||
ClickCount = ccAny
|
||||
ClickDir = cdDown
|
||||
Command = 15
|
||||
MoveCaret = False
|
||||
Option = 0
|
||||
Priority = 0
|
||||
Command = emcCodeFoldExpand
|
||||
end
|
||||
item
|
||||
Shift = []
|
||||
ShiftMask = [ssCtrl]
|
||||
Button = mbLeft
|
||||
ClickCount = ccAny
|
||||
ClickDir = cdDown
|
||||
Command = 15
|
||||
MoveCaret = False
|
||||
Command = emcCodeFoldExpand
|
||||
Option = 1
|
||||
Priority = 0
|
||||
end>
|
||||
end
|
||||
end
|
||||
|
||||
@ -97,6 +97,8 @@ type
|
||||
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);
|
||||
@ -183,6 +185,17 @@ 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;
|
||||
@ -208,7 +221,6 @@ begin
|
||||
XMLSynEdit.Lines.Clear;
|
||||
end;
|
||||
|
||||
|
||||
procedure TGUITestRunner.GUITestRunnerCreate(Sender: TObject);
|
||||
begin
|
||||
barColor := clGreen;
|
||||
@ -326,6 +338,12 @@ begin
|
||||
XMLSynEdit.Lines.SaveToFile(UTF8ToSys(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);
|
||||
|
||||
@ -380,7 +398,7 @@ end;
|
||||
|
||||
procedure TGUITestRunner.actCopyErrorMsgExecute(Sender: TObject);
|
||||
begin
|
||||
ClipBoard.AsText := Copy(TestTree.Selected.text, 10, MaxInt)
|
||||
ClipBoard.AsText := (TestTree.Selected as TMessageTreeNode).Message;
|
||||
end;
|
||||
|
||||
|
||||
@ -578,17 +596,20 @@ end;
|
||||
|
||||
procedure TGUITestRunner.AddFailure(ATest: TTest; AFailure: TTestFailure);
|
||||
var
|
||||
FailureNode, node: TTreeNode;
|
||||
FailureNode: TTreeNode;
|
||||
node: TMessageTreeNode;
|
||||
begin
|
||||
FailureNode := FindNode(ATest);
|
||||
if Assigned(FailureNode) then
|
||||
begin
|
||||
node := TestTree.Items.AddChild(FailureNode, Format(rsMessage, [
|
||||
FirstLine(AFailure.ExceptionMessage)]));
|
||||
node := TestTree.Items.AddChild(FailureNode,
|
||||
Format(rsMessage, [FirstLine(AFailure.ExceptionMessage)]))
|
||||
as TMessageTreeNode;
|
||||
node.Message := AFailure.ExceptionMessage;
|
||||
node.ImageIndex := 4;
|
||||
node.SelectedIndex := 4;
|
||||
node := TestTree.Items.AddChild(FailureNode, Format(rsException, [
|
||||
AFailure.ExceptionClassName]));
|
||||
node := TestTree.Items.AddChild(FailureNode,
|
||||
Format(rsException, [AFailure.ExceptionClassName])) as TMessageTreeNode;
|
||||
node.ImageIndex := 4;
|
||||
node.SelectedIndex := 4;
|
||||
PaintNodeFailure(FailureNode);
|
||||
@ -602,14 +623,17 @@ end;
|
||||
procedure TGUITestRunner.AddError(ATest: TTest; AError: TTestFailure);
|
||||
var
|
||||
ErrorNode, node: TTreeNode;
|
||||
MessageNode: TMessageTreeNode;
|
||||
begin
|
||||
ErrorNode := FindNode(ATest);
|
||||
if Assigned(ErrorNode) then
|
||||
begin
|
||||
node := TestTree.Items.AddChild(ErrorNode, Format(rsExceptionMes, [
|
||||
FirstLine(AError.ExceptionMessage)]));
|
||||
node.ImageIndex := 4;
|
||||
node.SelectedIndex := 4;
|
||||
MessageNode := TestTree.Items.AddChild(ErrorNode,
|
||||
Format(rsExceptionMes, [FirstLine(AError.ExceptionMessage)]))
|
||||
as TMessageTreeNode;
|
||||
MessageNode.Message := AError.ExceptionMessage;
|
||||
MessageNode.ImageIndex := 4;
|
||||
MessageNode.SelectedIndex := 4;
|
||||
node := TestTree.Items.AddChild(ErrorNode, Format(rsExceptionCla, [
|
||||
AError.ExceptionClassName]));
|
||||
node.ImageIndex := 4;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user