diff --git a/.gitattributes b/.gitattributes index 6e7bc6852d..ddfd0352b2 100644 --- a/.gitattributes +++ b/.gitattributes @@ -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 diff --git a/components/codetools/tests/parsertbase.pas b/components/codetools/tests/parsertbase.pas new file mode 100644 index 0000000000..099b1b45c4 --- /dev/null +++ b/components/codetools/tests/parsertbase.pas @@ -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. + diff --git a/components/codetools/tests/parsertest.lpi b/components/codetools/tests/parsertest.lpi new file mode 100644 index 0000000000..edc9255257 --- /dev/null +++ b/components/codetools/tests/parsertest.lpi @@ -0,0 +1,86 @@ + + + + + + + + + + + + + <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> diff --git a/components/codetools/tests/parsertest.lpr b/components/codetools/tests/parsertest.lpr new file mode 100644 index 0000000000..7dd1aa2690 --- /dev/null +++ b/components/codetools/tests/parsertest.lpr @@ -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. +