mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-11-04 03:39:48 +01:00
375 lines
11 KiB
ObjectPascal
375 lines
11 KiB
ObjectPascal
{ Copyright (C) 2004 Vincent Snijders
|
|
|
|
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.
|
|
|
|
|
|
Abstract:
|
|
This unit adds a new project type and a new unit type to the IDE.
|
|
New Project Type:
|
|
FPCUnit Application - A Free Pascal program for FPCUnit tests.
|
|
|
|
New Unit Type:
|
|
FPCUnit test - A unit with a unit test.
|
|
|
|
See the README file for more information.
|
|
}
|
|
unit FPCUnitLazIDEIntf;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, LazIDEIntf, ProjectIntf, Controls, Forms, testcaseopts;
|
|
|
|
type
|
|
{ TFPCUnitApplicationDescriptor }
|
|
|
|
TFPCUnitApplicationDescriptor = class(TProjectDescriptor)
|
|
public
|
|
constructor Create; override;
|
|
function GetLocalizedName: string; override;
|
|
function GetLocalizedDescription: string; override;
|
|
function InitProject(AProject: TLazProject): TModalResult; override;
|
|
function CreateStartFiles(AProject: TLazProject): TModalResult; override;
|
|
end;
|
|
|
|
{ TFPCUnitConsoleApplicationDescriptor }
|
|
|
|
TFPCUnitConsoleApplicationDescriptor = class(TProjectDescriptor)
|
|
public
|
|
constructor Create; override;
|
|
function GetLocalizedName: string; override;
|
|
function GetLocalizedDescription: string; override;
|
|
function InitProject(AProject: TLazProject): TModalResult; override;
|
|
function CreateStartFiles(AProject: TLazProject): TModalResult; override;
|
|
end;
|
|
|
|
{ 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;
|
|
function GetInterfaceSource(const Filename, SourceName,
|
|
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;
|
|
ProjectDescriptorFPCUnitConsoleApp: TFPCUnitConsoleApplicationDescriptor;
|
|
FileDescriptorFPCUnitTestCase: TFileDescPascalUnitFPCUnitTestCase;
|
|
|
|
procedure Register;
|
|
|
|
implementation
|
|
|
|
resourcestring
|
|
sFPCUnTestApp = 'FPCUnit Test Application';
|
|
sFPCUnTestAppDesc = 'FPCUnit Test Application%sAn application to run '
|
|
+'FPCUnit test cases.%sThe application source is automatically maintained by '
|
|
+'Lazarus.';
|
|
sFPCUnTestCase = 'FPCUnit Test Case';
|
|
sFPCUnTestCaseDesc = 'FPCUnit Test Case%sA unit containing a FPCUnit Test '
|
|
+'Case.';
|
|
sWriteYourOwnTest = 'Write your own test';
|
|
sFPCUnConsoleTestApp = 'FPCUnit Console Test Application';
|
|
sFPCUnConsoleTestDesc = 'FPCUnit Console Test Application%sAn application '
|
|
+'to run FPCUnit test cases in console mode.%sThe application source is '
|
|
+'automatically maintained by Lazarus.';
|
|
|
|
procedure Register;
|
|
begin
|
|
FileDescriptorFPCUnitTestCase:=TFileDescPascalUnitFPCUnitTestCase.Create;
|
|
RegisterProjectFileDescriptor(FileDescriptorFPCUnitTestCase);
|
|
ProjectDescriptorFPCUnitConsoleApp := TFPCUnitConsoleApplicationDescriptor.Create;
|
|
RegisterProjectDescriptor(ProjectDescriptorFPCUnitConsoleApp);
|
|
ProjectDescriptorFPCUnitApplication:=TFPCUnitApplicationDescriptor.Create;
|
|
RegisterProjectDescriptor(ProjectDescriptorFPCUnitApplication);
|
|
end;
|
|
|
|
{ TFPCUnitApplicationDescriptor }
|
|
|
|
constructor TFPCUnitApplicationDescriptor.Create;
|
|
begin
|
|
inherited Create;
|
|
Name:='FPCUnit Application';
|
|
end;
|
|
|
|
function TFPCUnitApplicationDescriptor.GetLocalizedName: string;
|
|
begin
|
|
Result:=sFPCUnTestApp;
|
|
end;
|
|
|
|
function TFPCUnitApplicationDescriptor.GetLocalizedDescription: string;
|
|
var
|
|
le: string;
|
|
begin
|
|
le := System.LineEnding;
|
|
Result:=Format(sFPCUnTestAppDesc,[le+le,le]);
|
|
end;
|
|
|
|
function TFPCUnitApplicationDescriptor.InitProject(AProject: TLazProject): TModalResult;
|
|
var
|
|
le: string;
|
|
NewSource: String;
|
|
MainFile: TLazProjectFile;
|
|
begin
|
|
inherited InitProject(AProject);
|
|
|
|
MainFile:=AProject.CreateProjectFile('fpcunitproject1.lpr');
|
|
MainFile.IsPartOfProject:=true;
|
|
AProject.AddFile(MainFile,false);
|
|
AProject.MainFileID:=0;
|
|
AProject.UseAppBundle:=true;
|
|
AProject.UseManifest:=true;
|
|
AProject.LoadDefaultIcon;
|
|
|
|
// create program source
|
|
le:=LineEnding;
|
|
NewSource:='program FPCUnitProject1;'+le
|
|
+le
|
|
+'{$mode objfpc}{$H+}'+le
|
|
+le
|
|
+'uses'+le
|
|
+' Interfaces, Forms, GuiTestRunner;'+le
|
|
+le
|
|
+'begin'+le
|
|
+' Application.Initialize;'+le
|
|
+' Application.CreateForm(TGuiTestRunner, TestRunner);'+le
|
|
+' Application.Run;'+le
|
|
+'end.'+le
|
|
+le;
|
|
AProject.MainFile.SetSourceText(NewSource);
|
|
|
|
// add
|
|
AProject.AddPackageDependency('FCL');
|
|
AProject.AddPackageDependency('LCL');
|
|
AProject.AddPackageDependency('FPCUnitTestRunner');
|
|
|
|
// compiler options
|
|
AProject.LazCompilerOptions.UseLineInfoUnit:=true;
|
|
Result:=mrOK;
|
|
end;
|
|
|
|
function TFPCUnitApplicationDescriptor.CreateStartFiles(AProject: TLazProject): TModalResult;
|
|
begin
|
|
LazarusIDE.DoNewEditorFile(FileDescriptorFPCUnitTestCase,'','',
|
|
[nfIsPartOfProject,nfOpenInEditor,nfCreateDefaultSrc]);
|
|
Result:=mrOK;
|
|
end;
|
|
|
|
{ TFileDescPascalUnitFPCUnitTestCase }
|
|
|
|
constructor TFileDescPascalUnitFPCUnitTestCase.Create;
|
|
begin
|
|
inherited Create;
|
|
Name:='FPCUnit TestCase';
|
|
DefaultFilename:='testcase.pas';
|
|
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;
|
|
Result:=Result+', fpcunit, testutils, testregistry';
|
|
end;
|
|
|
|
function TFileDescPascalUnitFPCUnitTestCase.GetLocalizedName: string;
|
|
begin
|
|
Result:=sFPCUnTestCase;
|
|
end;
|
|
|
|
function TFileDescPascalUnitFPCUnitTestCase.GetLocalizedDescription: string;
|
|
begin
|
|
Result:=Format(sFPCUnTestCaseDesc,[#13]);
|
|
end;
|
|
|
|
function TFileDescPascalUnitFPCUnitTestCase.GetInterfaceSource(const Filename,
|
|
SourceName, ResourceName: string): string;
|
|
var
|
|
le: string;
|
|
setupMethod: string;
|
|
teardownMethod: string;
|
|
protectedSection: string;
|
|
begin
|
|
le:=System.LineEnding;
|
|
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;
|
|
end;
|
|
|
|
function TFileDescPascalUnitFPCUnitTestCase.GetImplementationSource(
|
|
const Filename, SourceName, ResourceName: string): string;
|
|
var
|
|
le: string;
|
|
setupMethod: string;
|
|
teardownMethod: string;
|
|
begin
|
|
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('+QuotedStr(sWriteYourOwnTest)+');'+le
|
|
+'end;'+le
|
|
+le
|
|
+setupMethod
|
|
+le
|
|
+teardownMethod
|
|
+le
|
|
+'Initialization'+le
|
|
+le
|
|
+' RegisterTest('+TestCaseName+');'
|
|
+le;
|
|
end;
|
|
|
|
{ TFPCUnitConsoleApplicationDescriptor }
|
|
|
|
constructor TFPCUnitConsoleApplicationDescriptor.Create;
|
|
begin
|
|
inherited Create;
|
|
Name:='FPCUnit Console Application';
|
|
end;
|
|
|
|
function TFPCUnitConsoleApplicationDescriptor.GetLocalizedName: string;
|
|
begin
|
|
Result:=sFPCUnConsoleTestApp;
|
|
end;
|
|
|
|
function TFPCUnitConsoleApplicationDescriptor.GetLocalizedDescription: string;
|
|
var
|
|
le: string;
|
|
begin
|
|
le := System.LineEnding;
|
|
Result:=Format(sFPCUnConsoleTestDesc,[le+le,le]);
|
|
end;
|
|
|
|
function TFPCUnitConsoleApplicationDescriptor.InitProject(
|
|
AProject: TLazProject): TModalResult;
|
|
var
|
|
NewSource: string;
|
|
MainFile: TLazProjectFile;
|
|
begin
|
|
inherited InitProject(AProject);
|
|
|
|
MainFile:=AProject.CreateProjectFile('fpcunitproject1.lpr');
|
|
MainFile.IsPartOfProject:=true;
|
|
AProject.AddFile(MainFile,false);
|
|
AProject.MainFileID:=0;
|
|
|
|
// create program source
|
|
{$i fpcunitproject1.inc}
|
|
|
|
AProject.MainFile.SetSourceText(NewSource);
|
|
|
|
// add FCL dependency
|
|
AProject.AddPackageDependency('FCL');
|
|
AProject.AddPackageDependency('FPCUnitConsoleRunner');
|
|
|
|
// compiler options
|
|
AProject.LazCompilerOptions.UseLineInfoUnit:=true;
|
|
Result:=mrOK;
|
|
end;
|
|
|
|
function TFPCUnitConsoleApplicationDescriptor.CreateStartFiles(
|
|
AProject: TLazProject): TModalResult;
|
|
begin
|
|
LazarusIDE.DoNewEditorFile(FileDescriptorFPCUnitTestCase,'','',
|
|
[nfIsPartOfProject,nfOpenInEditor,nfCreateDefaultSrc]);
|
|
Result:=mrOK;
|
|
end;
|
|
|
|
end.
|
|
|