paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-22 12:40:00 +02:00
Code Issues Packages Projects Releases Wiki Activity

added dialog for choosing testcase name from Dean

Browse Source 
git-svn-id: trunk@7131 -
This commit is contained in:
vincents 2005-05-03 07:56:14 +00:00
parent f8ed47daf6
commit 9660bee67f
6 changed files with 256 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.gitattributes vendored
View File

@ -72,6 +72,9 @@ components/fpcunit/ide/fpcunitide.lpk svneol=native#text/pascal
components/fpcunit/ide/fpcunitide.pas svneol=native#text/pascal
components/fpcunit/ide/fpcunitlazideintf.pas svneol=native#text/pascal
components/fpcunit/ide/lib/README.txt svneol=native#text/plain
components/fpcunit/ide/testcaseopts.lfm svneol=native#text/plain
components/fpcunit/ide/testcaseopts.lrs svneol=native#text/pascal
components/fpcunit/ide/testcaseopts.pas svneol=native#text/pascal
components/fpcunit/lib/README.txt svneol=native#text/plain
components/gtk/gtkglarea/gtkglarea.lrs svneol=native#text/pascal
components/gtk/gtkglarea/gtkglarea_int.pp svneol=native#text/pascal

4
components/fpcunit/guitestrunner.pas
View File

@ -125,8 +125,6 @@ begin
end;
procedure TGUITestRunner.GUITestRunnerCreate(Sender: TObject);
var
i: integer;
begin
barColor := clGreen;
TestTree.Items.Clear;
@ -198,8 +196,6 @@ begin
end;
procedure TGUITestRunner.TestTreeSelectionChanged(Sender: TObject);
var
i: integer;
begin
if ((Sender as TTreeView).Selected <> nil) and
Assigned((Sender as TTreeview).Selected.Data) then

95
components/fpcunit/ide/fpcunitlazideintf.pas
View File

@ -32,7 +32,7 @@ unit FPCUnitLazIDEIntf;
interface
uses
Classes, SysUtils, LazIDEIntf, ProjectIntf;
Classes, SysUtils, LazIDEIntf, ProjectIntf, testcaseopts;
type
{ TFPCUnitApplicationDescriptor }
@ -49,8 +49,14 @@ type
{ TFileDescPascalUnitFPCUnitTestCase }
TFileDescPascalUnitFPCUnitTestCase = class(TFileDescPascalUnit)
private
FTestCaseName: string;
FCreateSetup: boolean;
FCreateTearDown: boolean;
public
constructor Create; override;
function CreateSource(const Filename, SourceName,
ResourceName: string): string; override;
function GetInterfaceUsesSection: string; override;
function GetLocalizedName: string; override;
function GetLocalizedDescription: string; override;
@ -58,12 +64,15 @@ type
ResourceName: string): string;override;
function GetImplementationSource(const Filename, SourceName,
ResourceName: string): string; override;
property TestCaseName: string read FTestCaseName write FTestCaseName;
property CreateSetup: boolean read FCreateSetup write FCreateSetup;
property CreateTeardown: boolean read FCreateTeardown write FCreateTeardown;
end;
var
ProjectDescriptorFPCUnitApplication: TFPCUnitApplicationDescriptor;
FileDescriptorFPCUnitTestCase: TFileDescPascalUnitFPCUnitTestCase;
procedure Register;
implementation
@ -155,6 +164,51 @@ begin
DefaultSourceName:='TestCase1';
end;
function TFileDescPascalUnitFPCUnitTestCase.CreateSource(const Filename,
SourceName, ResourceName: string): string;
var
LE: string;
begin
CreateSetup := false;
CreateTeardown := false;
LE:=LineEnding;
with TTestCaseOptionsForm.Create(nil) do
try
edDefaultName.Text := 'T' + SourceName;
ShowModal;
if edDefaultName.Text <> '' then
TestCaseName := edDefaultName.Text
else
TestCaseName:= 'T' + SourceName;
if cbSetup.Checked then
CreateSetup := True
else
CreateSetup := False;
if cbTeardown.Checked then
CreateTeardown := True
else
CreateTeardown := False;
finally
Free;
end;
Result:=
'unit '+SourceName+';'+LE
+LE
+'{$mode objfpc}{$H+}'+LE
+LE
+'interface'+LE
+LE
+'uses'+LE
+' '+GetInterfaceUsesSection+';'+LE
+LE
+GetInterfaceSource(Filename,SourceName,ResourceName)
+'implementation'+LE
+LE
+GetImplementationSource(Filename,SourceName,ResourceName)
+'end.'+LE
+LE;
end;
function TFileDescPascalUnitFPCUnitTestCase.GetInterfaceUsesSection: string;
begin
Result:=inherited GetInterfaceUsesSection;
@ -176,12 +230,23 @@ function TFileDescPascalUnitFPCUnitTestCase.GetInterfaceSource(const Filename,
SourceName, ResourceName: string): string;
var
le: string;
TestCaseName: string;
setupMethod: string;
teardownMethod: string;
protectedSection: string;
begin
TestCaseName:= 'T'+SourceName;
le:=System.LineEnding;
Result:='type'+le
+' '+TestCaseName+'=class(TTestCase)'+le
if CreateSetup or CreateTeardown then
protectedSection := ' protected' + le;
if CreateSetup then
setupMethod := ' procedure SetUp; override;' + le;
if CreateTeardown then
teardownMethod := ' procedure TearDown; override;' + le;
Result := 'type' + le
+ le
+' '+TestCaseName+'= class(TTestCase)'+le
+ protectedSection
+ setupMethod
+ teardownMethod
+' published'+le
+' procedure TestHookUp;'+le
+' end;'+le+le;
@ -191,15 +256,29 @@ function TFileDescPascalUnitFPCUnitTestCase.GetImplementationSource(
const Filename, SourceName, ResourceName: string): string;
var
le: string;
TestCaseName: string;
setupMethod: string;
teardownMethod: string;
begin
TestCaseName:= 'T'+SourceName;
le:=System.LineEnding;
if CreateSetup then
setupMethod := 'procedure '+TestCaseName+'.SetUp;'+le
+'begin'+le
+le
+'end;'+le;
if CreateTeardown then
teardownMethod := 'procedure '+TestCaseName+'.TearDown;'+le
+'begin'+le
+le
+'end;'+le;
Result:='procedure '+TestCaseName+'.TestHookUp;'+le
+'begin'+le
+' Fail(''Write your own test'');'+le
+'end;'+le
+le
+setupMethod
+le
+teardownMethod
+le
+'Initialization'+le
+le
+' RegisterTest('+TestCaseName+');'

93
components/fpcunit/ide/testcaseopts.lfm Normal file
View File

@ -0,0 +1,93 @@
object TestCaseOptionsForm: TTestCaseOptionsForm
BorderStyle = bsDialog
Caption = 'TestCase Options'
ClientHeight = 248
ClientWidth = 266
PixelsPerInch = 95
Position = poDesktopCenter
HorzScrollBar.Page = 265
VertScrollBar.Page = 247
Left = 464
Height = 248
Top = 464
Width = 266
object gbNames: TGroupBox
Align = alTop
BorderSpacing.OnChange = nil
Caption = 'Names'
ClientHeight = 72
ClientWidth = 262
ParentColor = True
TabOrder = 0
Height = 89
Width = 266
object Label1: TLabel
BorderSpacing.OnChange = nil
Caption = 'Default Test Name'
Color = clNone
FocusControl = edDefaultName
Left = 16
Height = 12
Top = 9
Width = 102
end
object edDefaultName: TEdit
BorderSpacing.OnChange = nil
MaxLength = 30
TabOrder = 0
Text = 'TTestCase1'
Left = 16
Height = 23
Top = 25
Width = 232
end
end
object Panel1: TPanel
Align = alBottom
BorderSpacing.OnChange = nil
BevelOuter = bvNone
ClientHeight = 42
ClientWidth = 266
FullRepaint = False
TabOrder = 1
Height = 42
Top = 206
Width = 266
object btnAccept: TButton
Caption = 'Create unit'
OnClick = btnAcceptClick
TabOrder = 0
Left = 64
Height = 25
Top = 10
Width = 120
end
end
object gbFixture: TGroupBox
Align = alClient
Caption = 'Fixture'
ClientHeight = 100
ClientWidth = 262
ParentColor = True
TabOrder = 2
Height = 117
Top = 89
Width = 266
object cbSetup: TCheckBox
Caption = 'Create Setup Method'
TabOrder = 0
Left = 22
Height = 23
Top = 11
Width = 216
end
object cbTeardown: TCheckBox
Caption = 'Create TearDown method'
TabOrder = 1
Left = 22
Height = 23
Top = 59
Width = 216
end
end
end

28
components/fpcunit/ide/testcaseopts.lrs Normal file
View File

@ -0,0 +1,28 @@
{ This is an automatically generated lazarus resource file }
LazarusResources.Add('TTestCaseOptionsForm','FORMDATA',[
'TPF0'#20'TTestCaseOptionsForm'#19'TestCaseOptionsForm'#11'BorderStyle'#7#8'b'
+'sDialog'#7'Caption'#6#16'TestCase Options'#12'ClientHeight'#3#248#0#11'Clie'
+'ntWidth'#3#10#1#13'PixelsPerInch'#2'_'#8'Position'#7#15'poDesktopCenter'#18
+'HorzScrollBar.Page'#3#9#1#18'VertScrollBar.Page'#3#247#0#4'Left'#3#208#1#6
+'Height'#3#248#0#3'Top'#3#208#1#5'Width'#3#10#1#0#9'TGroupBox'#7'gbNames'#5
+'Align'#7#5'alTop'#22'BorderSpacing.OnChange'#13#7'Caption'#6#5'Names'#12'Cl'
+'ientHeight'#2'H'#11'ClientWidth'#3#6#1#11'ParentColor'#9#8'TabOrder'#2#0#6
+'Height'#2'Y'#5'Width'#3#10#1#0#6'TLabel'#6'Label1'#22'BorderSpacing.OnChang'
+'e'#13#7'Caption'#6#17'Default Test Name'#5'Color'#7#6'clNone'#12'FocusContr'
+'ol'#7#13'edDefaultName'#4'Left'#2#16#6'Height'#2#12#3'Top'#2#9#5'Width'#2'f'
+#0#0#5'TEdit'#13'edDefaultName'#22'BorderSpacing.OnChange'#13#9'MaxLength'#2
+#30#8'TabOrder'#2#0#4'Text'#6#10'TTestCase1'#4'Left'#2#16#6'Height'#2#23#3'T'
+'op'#2#25#5'Width'#3#232#0#0#0#0#6'TPanel'#6'Panel1'#5'Align'#7#8'alBottom'
+#22'BorderSpacing.OnChange'#13#10'BevelOuter'#7#6'bvNone'#12'ClientHeight'#2
+'*'#11'ClientWidth'#3#10#1#11'FullRepaint'#8#8'TabOrder'#2#1#6'Height'#2'*'#3
+'Top'#3#206#0#5'Width'#3#10#1#0#7'TButton'#9'btnAccept'#7'Caption'#6#11'Crea'
+'te unit'#7'OnClick'#7#14'btnAcceptClick'#8'TabOrder'#2#0#4'Left'#2'@'#6'Hei'
+'ght'#2#25#3'Top'#2#10#5'Width'#2'x'#0#0#0#9'TGroupBox'#9'gbFixture'#5'Align'
+#7#8'alClient'#7'Caption'#6#7'Fixture'#12'ClientHeight'#2'd'#11'ClientWidth'
+#3#6#1#11'ParentColor'#9#8'TabOrder'#2#2#6'Height'#2'u'#3'Top'#2'Y'#5'Width'
+#3#10#1#0#9'TCheckBox'#7'cbSetup'#7'Caption'#6#19'Create Setup Method'#8'Tab'
+'Order'#2#0#4'Left'#2#22#6'Height'#2#23#3'Top'#2#11#5'Width'#3#216#0#0#0#9'T'
+'CheckBox'#10'cbTeardown'#7'Caption'#6#22'Create TearDown method'#8'TabOrder'
+#2#1#4'Left'#2#22#6'Height'#2#23#3'Top'#2';'#5'Width'#3#216#0#0#0#0#0
]);

45
components/fpcunit/ide/testcaseopts.pas Normal file
View File

@ -0,0 +1,45 @@
unit testcaseopts;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
ExtCtrls, Buttons;
type
{ TTestCaseOptionsForm }
TTestCaseOptionsForm = class(TForm)
btnAccept: TButton;
cbSetup: TCheckBox;
cbTeardown: TCheckBox;
edDefaultName: TEdit;
gbNames: TGroupBox;
gbFixture: TGroupBox;
Label1: TLabel;
Panel1: TPanel;
procedure btnAcceptClick(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
implementation
{ TTestCaseOptionsForm }
procedure TTestCaseOptionsForm.btnAcceptClick(Sender: TObject);
begin
Close;
end;
initialization
{$I testcaseopts.lrs}
end.