mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-15 21:19:26 +02:00
* pas2ut, initial version (create unit tests from pascal unit)
git-svn-id: trunk@22165 -
This commit is contained in:
michael
parent
28db5237fe
commit
eb2c0f52f4
4
.gitattributes
vendored
4
.gitattributes
vendored
@ -13945,6 +13945,10 @@ utils/mksymbian/mksymbian.lpi svneol=native#text/plain
|
||||
utils/mksymbian/mksymbian.pas svneol=native#text/plain
|
||||
utils/mksymbian/projectparser.pas svneol=native#text/plain
|
||||
utils/mksymbian/sdkutil.pas svneol=native#text/plain
|
||||
utils/pas2ut/Makefile svneol=native#text/plain
|
||||
utils/pas2ut/Makefile.fpc svneol=native#text/plain
|
||||
utils/pas2ut/pas2ut.lpi svneol=native#text/plain
|
||||
utils/pas2ut/pas2ut.pp svneol=native#text/plain
|
||||
utils/postw32.pp svneol=native#text/plain
|
||||
utils/ppdep.pp svneol=native#text/plain
|
||||
utils/ptop.pp svneol=native#text/plain
|
||||
|
||||
2645
utils/pas2ut/Makefile
Normal file
2645
utils/pas2ut/Makefile
Normal file
File diff suppressed because it is too large
Load Diff
28
utils/pas2ut/Makefile.fpc
Normal file
28
utils/pas2ut/Makefile.fpc
Normal file
@ -0,0 +1,28 @@
|
||||
#
|
||||
# Makefile.fpc for pas2ut
|
||||
#
|
||||
|
||||
[package]
|
||||
name=pas2ut
|
||||
version=2.7.1
|
||||
|
||||
[require]
|
||||
packages=fcl-passrc
|
||||
|
||||
[target]
|
||||
programs=pas2ut
|
||||
rst=pas2ut
|
||||
|
||||
[compiler]
|
||||
options=-S2h
|
||||
|
||||
[install]
|
||||
fpcpackage=y
|
||||
|
||||
[default]
|
||||
fpcdir=../..
|
||||
|
||||
[rules]
|
||||
.NOTPARALLEL:
|
||||
pas2ut$(EXEEXT): pas2ut.pp
|
||||
|
||||
77
utils/pas2ut/pas2ut.lpi
Normal file
77
utils/pas2ut/pas2ut.lpi
Normal file
@ -0,0 +1,77 @@
|
||||
<?xml version="1.0"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="9"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<MainUnitHasCreateFormStatements Value="False"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="Pascal code to Unit Tests"/>
|
||||
<UseAppBundle Value="False"/>
|
||||
<ResourceType Value="res"/>
|
||||
</General>
|
||||
<i18n>
|
||||
<EnableI18N LFM="False"/>
|
||||
</i18n>
|
||||
<VersionInfo>
|
||||
<StringTable ProductVersion=""/>
|
||||
</VersionInfo>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
|
||||
<ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
<LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<Units Count="2">
|
||||
<Unit0>
|
||||
<Filename Value="pas2ut.pp"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="pas2ut"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="pastounittest.pp"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="pastounittest"/>
|
||||
</Unit1>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<Target>
|
||||
<Filename Value="pas2ut"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Other>
|
||||
<CompilerMessages>
|
||||
<MsgFileName Value=""/>
|
||||
</CompilerMessages>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
309
utils/pas2ut/pas2ut.pp
Normal file
309
utils/pas2ut/pas2ut.pp
Normal file
@ -0,0 +1,309 @@
|
||||
{
|
||||
This file is part of the Free Pascal project
|
||||
Copyright (c) 2012 by the Free Pascal team
|
||||
|
||||
Pascal source to FPC Unit test generator program
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
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.
|
||||
|
||||
**********************************************************************}
|
||||
program pas2ut;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
Classes, SysUtils, pastounittest, pastree,CustApp;
|
||||
|
||||
Resourcestring
|
||||
SErrNoInput = 'Error: No input file specified';
|
||||
|
||||
SHelp0 = 'Usage : pp2ut [options] inputfile [outputfile]';
|
||||
SHelp1 = 'Where options is one or more of';
|
||||
SHelp2 = '--help this help';
|
||||
SHelp10 = '--test-protected also generate tests for protected class members' ;
|
||||
SHelp20 = '--skip-default skip tests for default visibility members' ;
|
||||
SHelp30 = '--skip-published skip tests for published members' ;
|
||||
SHelp40 = '--skip-public skip tests for public members';
|
||||
SHelp50 = '--tiopf tiopf tests (default,bounds,required,notify,maxlen)' ;
|
||||
SHelp60 = '--skip-property-default generate a default test for each property' ;
|
||||
SHelp70 = '--test-property-bounds generate a GetBounds test for each property' ;
|
||||
SHelp80 = '--test-property-required generate a Required test for each property' ;
|
||||
SHelp90 = '--test-property-notify generate a notify test for each property' ;
|
||||
SHelp100 = '--test-property-maxlen generate a maxlen test for each property' ;
|
||||
SHelp110 = '--skip-implementation Do not generate (empty) implementation for the tests' ;
|
||||
SHelp120 = '--skip-fail Skip fail() statement in test implementations ' ;
|
||||
SHelp130 = '--skip-unit Do not generate a unit' ;
|
||||
SHelp140 = '--skip-setup Skip TestCase class Setup() method' ;
|
||||
SHelp150 = '--skip-teardown Skip testcase class TearDown() method' ;
|
||||
SHelp160 = '--skip-functions Skip tests for functions/procedures' ;
|
||||
SHelp170 = '--skip-classes Skip tests for classes' ;
|
||||
SHelp180 = '--skip-register Do not generate RegisterTests statement' ;
|
||||
SHelp190 = '--singletestclass Use a single test class' ;
|
||||
SHelp200 = '--skip-methods Skip tests for methods of classes' ;
|
||||
SHelp210 = '--skip-fields Skip tests for fields of classes';
|
||||
SHelp220 = '--skip-properties Skip tests for properties of classes ' ;
|
||||
SHelp230 = '--testparentname=name Set the name of the parent class of test classes' ;
|
||||
SHelp240 = '--testunitname=name Set the name of the generated unit (default is taken from output file name)' ;
|
||||
SHelp250 = '--failmessage=Msg Set the message for the Fail() statement ' ;
|
||||
SHelp260 = '--unittestclassname=name Set the global unit test class name' ;
|
||||
SHelp270 = '--prefix=name Set the prefix for the test names (default is "Test") ' ;
|
||||
SHelp280 = '--limit=list Specify a comma-separated list of global identifiers for which to generate tests.' ;
|
||||
SHelp290 = '--defaultclasstest=list Specify a comma-separated list of default tests for each class' ;
|
||||
SHelp400 = '--limit and --defaultclasstest may be specified multiple times.';
|
||||
|
||||
|
||||
type
|
||||
{ TPasToUnitTestApplication }
|
||||
|
||||
TPasToUnitTestApplication = class(TCustomApplication)
|
||||
Private
|
||||
FCodeGen : TFPTestCodeCreator;
|
||||
FInputFile,FoutputFile : string;
|
||||
function CheckOptions : Boolean;
|
||||
protected
|
||||
procedure DoRun; override;
|
||||
public
|
||||
constructor Create(TheOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
procedure WriteHelp; virtual;
|
||||
end;
|
||||
|
||||
{ TPasToUnitTestApplication }
|
||||
|
||||
function TPasToUnitTestApplication.CheckOptions : Boolean;
|
||||
|
||||
Procedure ov(value : TPasMemberVisibility;incl: Boolean);
|
||||
|
||||
begin
|
||||
if incl then
|
||||
FCodeGen.Visibilities:=FCodeGen.Visibilities+[value]
|
||||
else
|
||||
FCodeGen.Visibilities:=FCodeGen.Visibilities-[value]
|
||||
end;
|
||||
|
||||
Procedure op(value : TTestPropertyOption;incl: Boolean);
|
||||
|
||||
begin
|
||||
if incl then
|
||||
FCodeGen.PropertyOptions:=FCodeGen.PropertyOptions+[value]
|
||||
else
|
||||
FCodeGen.PropertyOptions:=FCodeGen.PropertyOptions-[value]
|
||||
end;
|
||||
|
||||
Procedure oc(value : TTestCodeOption;incl: Boolean);
|
||||
|
||||
begin
|
||||
if incl then
|
||||
FCodeGen.CodeOptions:=FCodeGen.CodeOptions+[value]
|
||||
else
|
||||
FCodeGen.CodeOptions:=FCodeGen.CodeOptions-[value]
|
||||
end;
|
||||
|
||||
Procedure om(value : TTestMemberType;incl: Boolean);
|
||||
|
||||
begin
|
||||
if incl then
|
||||
FCodeGen.MemberTypes:=FCodeGen.MemberTypes+[value]
|
||||
else
|
||||
FCodeGen.MemberTypes:=FCodeGen.MemberTypes-[value]
|
||||
end;
|
||||
|
||||
Procedure AddValues(S : String; List : Tstrings);
|
||||
|
||||
Var
|
||||
P : Integer;
|
||||
V : String;
|
||||
|
||||
begin
|
||||
Repeat
|
||||
P:=Pos(',',S);
|
||||
If P=0 then
|
||||
P:=Length(S)+1;
|
||||
V:=Trim(Copy(S,1,P-1));
|
||||
If (V<>'') then
|
||||
List.Add(V);
|
||||
until (S='');
|
||||
end;
|
||||
|
||||
Var
|
||||
S,O : string;
|
||||
I,p : Integer;
|
||||
|
||||
begin
|
||||
Result:=False;
|
||||
I:=1;
|
||||
While (I<=ParamCount) do
|
||||
begin
|
||||
S:=ParamStr(I);
|
||||
P:=pos('=',S);
|
||||
if (P>0) then
|
||||
begin
|
||||
O:=S;
|
||||
Delete(O,1,P);
|
||||
S:=lowercase(Copy(S,1,P-1));
|
||||
end
|
||||
else
|
||||
O:='';
|
||||
if s='--test-protected' then
|
||||
ov(visProtected,true)
|
||||
else if s='--skip-default' then
|
||||
ov(visDefault,false)
|
||||
else if s='--skip-published' then
|
||||
ov(visPublished,false)
|
||||
else if s='--skip-public' then
|
||||
ov(visPublic,false)
|
||||
else if s='--tiopf' then
|
||||
begin
|
||||
FCodeGen.PropertyOptions:=[tDefault,tGetBounds,tRequired,tNotify,tMaxLen];
|
||||
end
|
||||
else if s='--skip-property-default' then
|
||||
op(tdefault,false)
|
||||
else if s='--test-property-bounds' then
|
||||
op(tgetBounds,true)
|
||||
else if s='--test-property-required' then
|
||||
op(trequired,true)
|
||||
else if s='--test-property-notify' then
|
||||
op(tNotify,true)
|
||||
else if s='--test-property-maxlen' then
|
||||
op(tMaxLen,true)
|
||||
else if s='--skip-implementation' then
|
||||
oc(coImplementation,false)
|
||||
else if s='--skip-fail' then
|
||||
oc(coDefaultFail,false)
|
||||
else if s='--skip-unit' then
|
||||
oc(coCreateUnit,false)
|
||||
else if s='--skip-setup' then
|
||||
oc(coSetup,false)
|
||||
else if s='--skip-teardown' then
|
||||
oc(coTeardown,false)
|
||||
else if s='--skip-functions' then
|
||||
oc(coFunctions,false)
|
||||
else if s='--skip-classes' then
|
||||
oc(coClasses,false)
|
||||
else if s='--skip-register' then
|
||||
oc(coRegisterTests,false)
|
||||
else if s='--singletestclass' then
|
||||
oc(coSingleClass,true)
|
||||
else if s='--skip-methods' then
|
||||
om(tmtMethods,false)
|
||||
else if s='--skip-fields' then
|
||||
om(tmtMethods,false)
|
||||
else if s='--skip-properties' then
|
||||
om(tmtMethods,false)
|
||||
else if (s='--testparentname') then
|
||||
FCodeGen.TestClassParent:=o
|
||||
else if (s='--testunitname') then
|
||||
FCodeGen.DestUnitname:=o
|
||||
else if (s='--failmessage') then
|
||||
FCodeGen.Failmessage:=o
|
||||
else if (s='--unittestclassname') then
|
||||
FCodeGen.UnitTestClassName:=O
|
||||
else if (s='--prefix') then
|
||||
FCodeGen.TestNamePrefix:=O
|
||||
else if (s='--limit') then
|
||||
AddValues(S,FCodeGen.LimitIdentifiers)
|
||||
else if (s='--defaultclasstest') then
|
||||
AddValues(S,FCodeGen.DefaultClassTests)
|
||||
else
|
||||
begin
|
||||
if (FInputFile='') then
|
||||
FInputFile:=s
|
||||
else if (FoutputFile<>'') then
|
||||
begin
|
||||
WriteHelp;
|
||||
Exit;
|
||||
end
|
||||
else
|
||||
FoutputFile:=s;
|
||||
end;
|
||||
Inc(I);
|
||||
end;
|
||||
Result:=FInputFile<>'';
|
||||
If Not Result then
|
||||
begin
|
||||
Writeln(SErrNoInput);
|
||||
WriteHelp;
|
||||
end;
|
||||
If (FOutputFile='') then
|
||||
FOutputFile:='tc'+FInputFile;
|
||||
end;
|
||||
|
||||
procedure TPasToUnitTestApplication.DoRun;
|
||||
var
|
||||
ErrorMsg: String;
|
||||
begin
|
||||
Terminate;
|
||||
// parse parameters
|
||||
if HasOption('h','help') then
|
||||
begin
|
||||
WriteHelp;
|
||||
Exit;
|
||||
end;
|
||||
if CheckOptions then
|
||||
FCodeGen.Execute(FInputfile,FOutputFile);
|
||||
end;
|
||||
|
||||
constructor TPasToUnitTestApplication.Create(TheOwner: TComponent);
|
||||
begin
|
||||
inherited Create(TheOwner);
|
||||
StopOnException:=True;
|
||||
FCodeGen :=TFPTestCodeCreator.Create(Self)
|
||||
end;
|
||||
|
||||
destructor TPasToUnitTestApplication.Destroy;
|
||||
begin
|
||||
FreeAndNil(FCodeGen);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TPasToUnitTestApplication.WriteHelp;
|
||||
begin
|
||||
Writeln(SHelp0);
|
||||
Writeln(SHelp1);
|
||||
Writeln(SHelp10 );
|
||||
Writeln(SHelp20 );
|
||||
Writeln(SHelp30 );
|
||||
Writeln(SHelp40 );
|
||||
Writeln(SHelp50 );
|
||||
Writeln(SHelp60 );
|
||||
Writeln(SHelp70 );
|
||||
Writeln(SHelp80 );
|
||||
Writeln(SHelp90 );
|
||||
Writeln(SHelp100);
|
||||
Writeln(SHelp110);
|
||||
Writeln(SHelp120);
|
||||
Writeln(SHelp130);
|
||||
Writeln(SHelp140);
|
||||
Writeln(SHelp150);
|
||||
Writeln(SHelp160);
|
||||
Writeln(SHelp170);
|
||||
Writeln(SHelp180);
|
||||
Writeln(SHelp190);
|
||||
Writeln(SHelp200);
|
||||
Writeln(SHelp210);
|
||||
Writeln(SHelp220);
|
||||
Writeln(SHelp230);
|
||||
Writeln(SHelp240);
|
||||
Writeln(SHelp250);
|
||||
Writeln(SHelp260);
|
||||
Writeln(SHelp270);
|
||||
Writeln(SHelp280);
|
||||
Writeln(SHelp290);
|
||||
Writeln(SHelp400);
|
||||
end;
|
||||
|
||||
var
|
||||
Application: TPasToUnitTestApplication;
|
||||
|
||||
begin
|
||||
Application:=TPasToUnitTestApplication.Create(nil);
|
||||
Application.Title:='Pascal code to Unit Tests';
|
||||
Application.Run;
|
||||
Application.Free;
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user