{ 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 . You can also obtain it by writing to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. } program finddeclarationtest; {$mode objfpc}{$H+} uses Classes, sysutils, consoletestrunner, dom, fpcunit, CodeToolManager, CodeToolsConfig, LazLogger, fdtbase, fdt_classhelper, fdt_nestedclasses; 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; DebugLn(['EnvironmentVariables: PP, FPCDIR, LAZARUSDIR, FPCTARGET, FPCTARGETCPU']); 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(WideString(name)); n.AppendChild(Doc.CreateTextNode(WideString(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 Find Declaration Suite.'; App.Run; App.Free; end.