paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-14 20:19:16 +02:00
Code Issues Packages Projects Releases Wiki Activity

codetools: test for parsing fpc test units

Browse Source 
git-svn-id: trunk@39820 -
This commit is contained in:
mattias 2013-01-10 14:08:31 +00:00
parent 0a8cd93bc5
commit d501e634d7
4 changed files with 302 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.gitattributes vendored
View File

@ -845,6 +845,9 @@ components/codetools/resourcecodetool.pas svneol=native#text/pascal
components/codetools/sourcechanger.pas svneol=native#text/pascal components/codetools/sourcechanger.pas svneol=native#text/pascal
components/codetools/sourcelog.pas svneol=native#text/pascal components/codetools/sourcelog.pas svneol=native#text/pascal
components/codetools/stdcodetools.pas svneol=native#text/pascal components/codetools/stdcodetools.pas svneol=native#text/pascal
components/codetools/tests/parsertbase.pas svneol=native#text/plain
components/codetools/tests/parsertest.lpi svneol=native#text/plain
components/codetools/tests/parsertest.lpr svneol=native#text/plain
components/codetools/unitdictionary.pas svneol=native#text/plain components/codetools/unitdictionary.pas svneol=native#text/plain
components/compilers/c/examples/test.c svneol=native#text/plain components/compilers/c/examples/test.c svneol=native#text/plain
components/compilers/c/lazc.lpk svneol=native#text/plain components/compilers/c/lazc.lpk svneol=native#text/plain

76
components/codetools/tests/parsertbase.pas Normal file
View File

@ -0,0 +1,76 @@
{
Test with:
./parsertest --format=plain --suite=TTestParseFPCTestUnits
./parsertest --format=plain --suite=TestParse_ugenconstraints
}
unit parsertbase;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, CodeToolManager, ExprEval, CodeCache, LazFileUtils,
LazLogger, fpcunit, testregistry;
type
{ TTestParseFPCTestUnits }
TTestParseFPCTestUnits = class(TTestCase)
private
published
procedure TestParse_ugenconstraints;
end;
var
BugsTestSuite: TTestSuite;
ParserTestSuite: TTestSuite;
procedure AddToBugsTestSuite(ATest: TTest);
procedure AddToParserTestSuite(ATestClass: TClass);
implementation
procedure AddToBugsTestSuite(ATest: TTest);
begin
BugsTestSuite.AddTest(ATest);
end;
procedure AddToParserTestSuite(ATestClass: TClass);
begin
ParserTestSuite.AddTestSuiteFromClass(ATestClass);
end;
{ TTestParseFPCTestUnits }
procedure TTestParseFPCTestUnits.TestParse_ugenconstraints;
var
FPCDir: String;
Filename: String;
Code: TCodeBuffer;
Tool: TCodeTool;
begin
FPCDir:=TrimFilename(CodeToolBoss.GlobalValues.Variables[ExternalMacroStart+'FPCSrcDir']);
if not DirPathExists(FPCDir) then
raise Exception.Create('FPCDIR not found: '+FPCDir);
Filename:=AppendPathDelim(FPCDir)+'tests/test/ugenconstraints.pas';
//debugln(['TTestParseFPCTestUnits.TestParse_ugenconstraints ',Filename]);
Code:=CodeToolBoss.LoadFile(Filename,true,false);
if Code=nil then
raise Exception.Create('unable to load '+Filename);
if not CodeToolBoss.Explore(Code,Tool,true) then begin
debugln(['TTestParseFPCTestUnits.TestParse_ugenconstraints ',CodeToolBoss.ErrorMessage]);
end;
end;
initialization
GetTestRegistry.TestName := 'All tests';
BugsTestSuite := TTestSuite.Create('Bugs');
GetTestRegistry.AddTest(BugsTestSuite);
ParserTestSuite := TTestSuite.Create('Parser');
GetTestRegistry.AddTest(ParserTestSuite);
AddToParserTestSuite(TTestParseFPCTestUnits);
end.

86
components/codetools/tests/parsertest.lpi Normal file
View File

@ -0,0 +1,86 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<General>
<Flags>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
</Flags>
<SessionStorage Value="InIDEConfig"/>
<MainUnit Value="0"/>
<Title Value="parsertest"/>
<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>
<RequiredPackages Count="2">
<Item1>
<PackageName Value="CodeTools"/>
</Item1>
<Item2>
<PackageName Value="fpcunitconsolerunner"/>
</Item2>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="parsertest.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="parsertest"/>
</Unit0>
<Unit1>
<Filename Value="parsertbase.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="parsertbase"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<Target>
<Filename Value="parsertest"/>
</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>

137
components/codetools/tests/parsertest.lpr Normal file
View File

@ -0,0 +1,137 @@
{ Copyright (C) 2013 Mattias Gaertner
This source is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free
Software Foundation; either version 2 of the License, or (at your option)
any later version.
This code 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 General Public License for more
details.
A copy of the GNU General Public License is available on the World Wide Web
at <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing
to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
MA 02111-1307, USA.
}
program parsertest;
{$mode objfpc}{$H+}
uses
Classes, sysutils, consoletestrunner, dom, fpcunit,
CodeToolManager, CodeToolsConfig, parsertbase;
const
ConfigFilename = 'codetools.config';
type
{ TCTTestRunner }
TCTTestRunner = class(TTestRunner)
private
FSubmitter: string;
FMachine: string;
protected
Options: TCodeToolsOptions;
procedure AppendLongOpts; override;
procedure ParseOptions; override;
procedure WriteCustomHelp; override;
procedure ExtendXmlDocument(Doc: TXMLDocument); override;
public
destructor Destroy; override;
end;
{ TCTTestRunner }
procedure TCTTestRunner.AppendLongOpts;
begin
inherited AppendLongOpts;
LongOpts.Add('machine:');
LongOpts.Add('submitter:');
end;
procedure TCTTestRunner.ParseOptions;
begin
inherited ParseOptions;
if Options=nil then
Options:=TCodeToolsOptions.Create;
if FileExists(ConfigFilename) then begin
// To not parse the FPC sources every time, the options are saved to a file.
Options.LoadFromFile(ConfigFilename);
end;
Options.InitWithEnvironmentVariables;
if HasOption('submitter') then
FSubmitter := GetOptionValue('submitter');
if HasOption('machine') then
FMachine := GetOptionValue('machine');
if Options.FPCSrcDir='' then
Options.FPCSrcDir:=ExpandFileName('~/freepascal/fpc');
if Options.LazarusSrcDir='' then
Options.LazarusSrcDir:=ExpandFileName('~/pascal/lazarus');
CodeToolBoss.Init(Options);
// save the options and the FPC unit links results.
Options.SaveToFile(ConfigFilename);
end;
procedure TCTTestRunner.WriteCustomHelp;
begin
inherited WriteCustomHelp;
writeln('Environment variables:');
writeln(' PP=path of the compiler');
writeln(' FPCDIR=path of the fpc sources');
writeln(' LAZARUSDIR=path of the lazarus sources');
writeln(' FPCTARGET=target OS');
writeln(' FPCTARGETCPU=target cpu');
writeln;
writeln('Command line parameters:');
writeln(' --submitter=SubmitterName name of sumbitter of the test results');
writeln(' --machine=MachineName name of the machine the test runs on');
end;
destructor TCTTestRunner.Destroy;
begin
FreeAndNil(Options);
inherited Destroy;
end;
procedure TCTTestRunner.ExtendXmlDocument(Doc: TXMLDocument);
var
env: TDOMElement;
procedure AddElement(const name, value: string);
var
n: TDOMElement;
begin
n := Doc.CreateElement(name);
n.AppendChild(Doc.CreateTextNode(value));
env.AppendChild(n);
end;
begin
inherited ExtendXmlDocument(Doc);
env := Doc.CreateElement('Environment');
AddElement('CPU', {$I %FPCTARGETCPU%});
AddElement('OS', {$I %FPCTARGETOS%});
AddElement('FPCVersion', {$I %FPCVERSION%});
AddElement('Submitter', FSubmitter);
AddElement('Machine', FMachine);
Doc.FirstChild.AppendChild(env);
end;
var
App: TCTTestRunner;
begin
App := TCTTestRunner.Create(nil);
App.Initialize;
App.Title := 'FPCUnit Console runner for the CodeTools Parser Suite.';
App.Run;
App.Free;
end.