mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-07 10:16:09 +02:00
codetools: test for parsing fpc test units
git-svn-id: trunk@39820 -
This commit is contained in:
mattias
parent
0a8cd93bc5
commit
d501e634d7
3
.gitattributes
vendored
3
.gitattributes
vendored
@ -845,6 +845,9 @@ components/codetools/resourcecodetool.pas svneol=native#text/pascal
|
||||
components/codetools/sourcechanger.pas svneol=native#text/pascal
|
||||
components/codetools/sourcelog.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/compilers/c/examples/test.c svneol=native#text/plain
|
||||
components/compilers/c/lazc.lpk svneol=native#text/plain
|
||||
|
||||
76
components/codetools/tests/parsertbase.pas
Normal file
76
components/codetools/tests/parsertbase.pas
Normal 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
86
components/codetools/tests/parsertest.lpi
Normal 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
137
components/codetools/tests/parsertest.lpr
Normal 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.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user