mirror of
https://gitlab.com/freepascal.org/fpc/pas2js.git
synced 2025-04-08 06:57:52 +02:00
releasecreator: started
This commit is contained in:
mattias
parent
72ff01f697
commit
d484ec70a4
tools/releasecreator
1
tools/releasecreator/.gitignore
vendored
Normal file
1
tools/releasecreator/.gitignore
vendored
Normal file
@ -0,0 +1 @@
|
||||
Pas2jsReleaseCreator
|
||||
70
tools/releasecreator/Pas2jsReleaseCreator.lpi
Normal file
70
tools/releasecreator/Pas2jsReleaseCreator.lpi
Normal file
@ -0,0 +1,70 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="12"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<MainUnitHasCreateFormStatements Value="False"/>
|
||||
<MainUnitHasScaledStatement Value="False"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<Title Value="Pas2js Release Creator"/>
|
||||
<UseAppBundle Value="False"/>
|
||||
<ResourceType Value="res"/>
|
||||
</General>
|
||||
<BuildModes>
|
||||
<Item Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<UseFileFilters Value="True"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<FormatVersion Value="2"/>
|
||||
</RunParams>
|
||||
<RequiredPackages>
|
||||
<Item>
|
||||
<PackageName Value="LazUtils"/>
|
||||
</Item>
|
||||
</RequiredPackages>
|
||||
<Units>
|
||||
<Unit>
|
||||
<Filename Value="Pas2jsReleaseCreator.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit>
|
||||
<Unit>
|
||||
<Filename Value="findwriteln.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="FindWriteln"/>
|
||||
</Unit>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<Target>
|
||||
<Filename Value="Pas2jsReleaseCreator"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<DebugInfoType Value="dsDwarf2"/>
|
||||
</Debugging>
|
||||
</Linking>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions>
|
||||
<Item>
|
||||
<Name Value="EAbort"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
313
tools/releasecreator/Pas2jsReleaseCreator.lpr
Normal file
313
tools/releasecreator/Pas2jsReleaseCreator.lpr
Normal file
@ -0,0 +1,313 @@
|
||||
program Pas2jsReleaseCreator;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
{$IFDEF UNIX}
|
||||
cthreads,
|
||||
{$ENDIF}
|
||||
LazUTF8, Classes, SysUtils, CustApp, IniFiles, LazFileUtils, FileUtil,
|
||||
FindWriteln;
|
||||
|
||||
const
|
||||
DefaultCfgFilename = 'pas2jsrelease.ini';
|
||||
|
||||
type
|
||||
TGetDefaultEvent = function(): string of object;
|
||||
|
||||
{ TPas2jsReleaseCreator }
|
||||
|
||||
TPas2jsReleaseCreator = class(TCustomApplication)
|
||||
protected
|
||||
procedure DoLog(EventType: TEventType; const Msg: String); override;
|
||||
procedure DoRun; override;
|
||||
procedure Err(const Msg: string);
|
||||
public
|
||||
CfgFilename: string;
|
||||
Ini: TIniFile;
|
||||
SourceDir: string; // cloned git release
|
||||
BuildDir: string;
|
||||
LazBuildFilename: string;
|
||||
Verbosity: integer;
|
||||
Pas2jsVersion: string;
|
||||
constructor Create(TheOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
procedure WriteHelp; virtual;
|
||||
procedure ReadVersion;
|
||||
procedure CheckForgottenWriteln;
|
||||
function GetDefaultCfgFilename: string;
|
||||
function GetDefaultBuildDir: string;
|
||||
function GetDefaultLazBuild: string;
|
||||
function GetOption_String(ShortOption: char; const LongOption: string): string;
|
||||
function GetOption_Directory(ShortOption: char; const LongOption: string; const GetDefaultFunc: TGetDefaultEvent): string;
|
||||
function GetOption_Executable(ShortOption: char; const LongOption: string; const GetDefaultFunc: TGetDefaultEvent): string;
|
||||
end;
|
||||
|
||||
{ TPas2jsReleaseCreator }
|
||||
|
||||
procedure TPas2jsReleaseCreator.DoLog(EventType: TEventType; const Msg: String);
|
||||
begin
|
||||
case EventType of
|
||||
etInfo: write('Info: ');
|
||||
etWarning: write('Warning: ');
|
||||
etError: write('Error: ');
|
||||
etDebug: write('Debug: ');
|
||||
else
|
||||
write('Custom: ');
|
||||
end;
|
||||
writeln(Msg);
|
||||
end;
|
||||
|
||||
procedure TPas2jsReleaseCreator.DoRun;
|
||||
var
|
||||
ErrorMsg: String;
|
||||
begin
|
||||
// quick check parameters
|
||||
ErrorMsg:=CheckOptions('hb:c:s:l:qvx', ['help', 'config:', 'lazbuild:',
|
||||
'builddir:', 'sourcedir:', 'quiet', 'verbose', 'execute']);
|
||||
if ErrorMsg<>'' then
|
||||
Err(ErrorMsg);
|
||||
|
||||
// parse basic parameters
|
||||
if HasOption('h', 'help') then begin
|
||||
WriteHelp;
|
||||
Terminate;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if HasOption('q','quiet') then
|
||||
dec(Verbosity);
|
||||
if HasOption('v','verbose') then
|
||||
inc(Verbosity);
|
||||
|
||||
// read config file
|
||||
if HasOption('c','config') then begin
|
||||
CfgFilename:=ExpandFileName(GetOptionValue('c','config'));
|
||||
if not FileExists(CfgFilename) then
|
||||
Err('Config file not found: "'+CfgFilename+'"');
|
||||
end else begin
|
||||
CfgFilename:=GetDefaultCfgFilename;
|
||||
end;
|
||||
if FileExists(CfgFilename) then begin
|
||||
if Verbosity>=0 then
|
||||
Log(etInfo,'Reading config file "'+CfgFilename+'" ...');
|
||||
Ini:=TIniFile.Create(CfgFilename);
|
||||
end;
|
||||
|
||||
BuildDir:=GetOption_Directory('b','builddir',@GetDefaultBuildDir);
|
||||
LazBuildFilename:=GetOption_Executable('l','lazbuild',@GetDefaultLazBuild);
|
||||
SourceDir:=GetOption_Directory('s','sourcedir',nil);
|
||||
if SourceDir='' then
|
||||
Err('missing source directory');
|
||||
|
||||
// write options
|
||||
if Verbosity>=0 then begin
|
||||
Log(etInfo,'BuildDir: "'+BuildDir+'"');
|
||||
Log(etInfo,'LazBuild: "'+LazBuildFilename+'"');
|
||||
Log(etInfo,'SourceDir: "'+SourceDir+'"');
|
||||
end;
|
||||
|
||||
if not HasOption('x','execute') then
|
||||
Log(etInfo,'Simulating...');
|
||||
|
||||
// preflight checks
|
||||
if not DirectoryExists(BuildDir) then
|
||||
Err('BuildDir missing: "'+BuildDir+'"');
|
||||
if not DirectoryExists(SourceDir) then
|
||||
Err('SourceDir missing: "'+SourceDir+'"');
|
||||
if not FileExists(LazBuildFilename) then
|
||||
Err('LazBuild missing: "'+LazBuildFilename+'"');
|
||||
if not FileIsExecutable(LazBuildFilename) then
|
||||
Err('LazBuild not executable: "'+LazBuildFilename+'"');
|
||||
|
||||
ReadVersion;
|
||||
CheckForgottenWriteln;
|
||||
|
||||
// stop program loop
|
||||
Terminate;
|
||||
end;
|
||||
|
||||
procedure TPas2jsReleaseCreator.Err(const Msg: string);
|
||||
begin
|
||||
Log(etError,Msg);
|
||||
Halt(1);
|
||||
end;
|
||||
|
||||
constructor TPas2jsReleaseCreator.Create(TheOwner: TComponent);
|
||||
begin
|
||||
inherited Create(TheOwner);
|
||||
StopOnException:=True;
|
||||
end;
|
||||
|
||||
destructor TPas2jsReleaseCreator.Destroy;
|
||||
begin
|
||||
FreeAndNil(Ini);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TPas2jsReleaseCreator.WriteHelp;
|
||||
begin
|
||||
writeln('Usage: ', ExeName, ' -h');
|
||||
writeln;
|
||||
writeln('-h, --help: Write this help and exit');
|
||||
writeln('-q, --quiet: Less verbose');
|
||||
writeln('-v, --verbose: More verbose');
|
||||
writeln('-b <filename>, --builddir=<filename>: Output directory where to build the zip.');
|
||||
writeln(' Default: '+GetDefaultBuildDir);
|
||||
writeln('-c <filename>, --config=<filename>: Path of ini file with a Main section.');
|
||||
writeln(' Default: '+GetDefaultCfgFilename);
|
||||
writeln('-l <filename>, --lazbuild=<filename>: Path of lazbuild executable.');
|
||||
writeln(' Default: '+GetDefaultLazBuild);
|
||||
writeln('-s <filename>, --sourcedir=<filename>: git directory of the pas2js release');
|
||||
writeln('-x, --execute: Do not simulate, execute the commands');
|
||||
end;
|
||||
|
||||
procedure TPas2jsReleaseCreator.ReadVersion;
|
||||
|
||||
function CheckConstInt(const Line, Identifier: string; var aValue: integer): boolean;
|
||||
var
|
||||
s: String;
|
||||
p, StartP: SizeInt;
|
||||
begin
|
||||
Result:=false;
|
||||
s:=' '+Identifier+' = ';
|
||||
if not SameText(LeftStr(Line,length(s)),s) then exit;
|
||||
p:=length(s)+1;
|
||||
StartP:=p;
|
||||
aValue:=0;
|
||||
while (p<=length(Line)) and (Line[p] in ['0'..'9']) do begin
|
||||
aValue:=aValue*10+ord(Line[p])-ord('0');
|
||||
inc(p);
|
||||
end;
|
||||
Result:=p>StartP;
|
||||
end;
|
||||
|
||||
type
|
||||
TVersionPart = (vMajor,vMinor,vRelease);
|
||||
const
|
||||
PartNames: array[TVersionPart] of string = ('VersionMajor','VersionMinor','VersionRelease');
|
||||
var
|
||||
Filename, Line: String;
|
||||
sl: TStringList;
|
||||
i: Integer;
|
||||
Parts: array[TVersionPart] of integer;
|
||||
PartFound: array[TVersionPart] of boolean;
|
||||
p: TVersionPart;
|
||||
begin
|
||||
Filename:=SourceDir+'compiler'+PathDelim+'packages'+PathDelim+'pastojs'+PathDelim+'src'+PathDelim+'pas2jscompiler.pp';
|
||||
if Verbosity>0 then
|
||||
Log(etInfo,'Reading version from "'+Filename+'" ...');
|
||||
if not FileExists(Filename) then
|
||||
Err('Missing source file: "'+Filename+'"');
|
||||
sl:=TStringList.Create;
|
||||
try
|
||||
sl.LoadFromFile(Filename);
|
||||
for p in TVersionPart do begin
|
||||
Parts[p]:=0;
|
||||
PartFound[p]:=false;
|
||||
end;
|
||||
for i:=0 to sl.Count-1 do begin
|
||||
Line:=sl[i];
|
||||
for p in TVersionPart do
|
||||
if not PartFound[p] then
|
||||
PartFound[p]:=CheckConstInt(Line,PartNames[p],Parts[p]);
|
||||
if PartFound[High(TVersionPart)] then begin
|
||||
if Verbosity>0 then
|
||||
Log(etInfo,'Found const '+PartNames[High(TVersionPart)]+' = '+IntToStr(Parts[High(TVersionPart)]));
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
|
||||
for p in TVersionPart do
|
||||
if not PartFound[p] then
|
||||
Err('Missing '+PartNames[p]+' in "'+Filename+'"');
|
||||
|
||||
Pas2jsVersion:=IntToStr(Parts[vMajor])+'.'+IntToStr(Parts[vMinor])+'.'+IntToStr(Parts[vRelease]);
|
||||
if Verbosity>=0 then
|
||||
Log(etInfo,'Pas2js version is '+Pas2jsVersion);
|
||||
finally
|
||||
sl.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPas2jsReleaseCreator.CheckForgottenWriteln;
|
||||
|
||||
procedure Check(const SrcDir: string);
|
||||
begin
|
||||
if not DirectoryExists(SrcDir) then
|
||||
Err('Missing dource directory: "'+SrcDir+'"');
|
||||
if Verbosity>=0 then
|
||||
Log(etInfo,'Checking for forgotten writeln: '+SrcDir+' ...');
|
||||
FindWritelnInDirectory(SrcDir,false,@DoLog);
|
||||
end;
|
||||
|
||||
begin
|
||||
Check(SourceDir+'compiler'+PathDelim+'packages'+PathDelim+'fcl-js'+PathDelim+'src');
|
||||
Check(SourceDir+'compiler'+PathDelim+'packages'+PathDelim+'fcl-json'+PathDelim+'src');
|
||||
Check(SourceDir+'compiler'+PathDelim+'packages'+PathDelim+'fcl-passrc'+PathDelim+'src');
|
||||
Check(SourceDir+'compiler'+PathDelim+'packages'+PathDelim+'pastojs'+PathDelim+'src');
|
||||
Check(SourceDir+'compiler'+PathDelim+'utils'+PathDelim+'pas2js');
|
||||
end;
|
||||
|
||||
function TPas2jsReleaseCreator.GetDefaultCfgFilename: string;
|
||||
begin
|
||||
Result:=ExpandFileName(DefaultCfgFilename);
|
||||
end;
|
||||
|
||||
function TPas2jsReleaseCreator.GetDefaultBuildDir: string;
|
||||
begin
|
||||
Result:=AppendPathDelim(ResolveDots(GetTempDir(false)));
|
||||
end;
|
||||
|
||||
function TPas2jsReleaseCreator.GetDefaultLazBuild: string;
|
||||
begin
|
||||
Result:='lazbuild';
|
||||
end;
|
||||
|
||||
function TPas2jsReleaseCreator.GetOption_String(ShortOption: char;
|
||||
const LongOption: string): string;
|
||||
begin
|
||||
if HasOption(ShortOption,LongOption) then begin
|
||||
Result:=GetOptionValue(ShortOption,LongOption);
|
||||
exit;
|
||||
end;
|
||||
if Ini<>nil then begin
|
||||
Result:=Ini.ReadString('Main',LongOption,'');
|
||||
exit;
|
||||
end;
|
||||
Result:='';
|
||||
end;
|
||||
|
||||
function TPas2jsReleaseCreator.GetOption_Directory(ShortOption: char;
|
||||
const LongOption: string; const GetDefaultFunc: TGetDefaultEvent): string;
|
||||
begin
|
||||
Result:=GetOption_String(ShortOption,LongOption);
|
||||
if (Result='') and Assigned(GetDefaultFunc) then
|
||||
Result:=GetDefaultFunc();
|
||||
if Result<>'' then
|
||||
Result:=AppendPathDelim(ExpandFileName(Result));
|
||||
end;
|
||||
|
||||
function TPas2jsReleaseCreator.GetOption_Executable(ShortOption: char;
|
||||
const LongOption: string; const GetDefaultFunc: TGetDefaultEvent): string;
|
||||
begin
|
||||
Result:=GetOption_String(ShortOption,LongOption);
|
||||
if Result='' then
|
||||
Result:=GetDefaultFunc();
|
||||
if Result='' then exit;
|
||||
if FilenameIsAbsolute(Result) then exit;
|
||||
if ExtractFilePath(Result)<>'' then
|
||||
Result:=ExpandFileName(Result)
|
||||
else
|
||||
Result:=FindDefaultExecutablePath(Result);
|
||||
end;
|
||||
|
||||
var
|
||||
Application: TPas2jsReleaseCreator;
|
||||
begin
|
||||
Application:=TPas2jsReleaseCreator.Create(nil);
|
||||
Application.Title:='Pas2js Release Creator';
|
||||
Application.Run;
|
||||
Application.Free;
|
||||
end.
|
||||
|
||||
273
tools/releasecreator/findwriteln.pas
Normal file
273
tools/releasecreator/findwriteln.pas
Normal file
@ -0,0 +1,273 @@
|
||||
unit FindWriteln;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils;
|
||||
|
||||
type
|
||||
TFindWritelnLog = procedure(EventType : TEventType; const Msg: string) of object;
|
||||
|
||||
function FindWritelnInDirectory(Dir: string; Recurse: boolean; const Log: TFindWritelnLog): integer;
|
||||
|
||||
implementation
|
||||
|
||||
function ReadNextToken(const Src: string; var SrcP: PChar; var Line: integer): string;
|
||||
var
|
||||
p, TokenStart: PChar;
|
||||
begin
|
||||
p:=SrcP;
|
||||
while p^ in [' ',#9] do inc(p);
|
||||
repeat
|
||||
case p^ of
|
||||
#0:
|
||||
if p-PChar(Src)=length(Src) then begin
|
||||
SrcP:=p;
|
||||
exit('');
|
||||
end
|
||||
else
|
||||
inc(p);
|
||||
#10,#13:
|
||||
begin
|
||||
inc(Line);
|
||||
if (p[1] in [#10,#13]) and (p^<>p[1]) then
|
||||
inc(p,2)
|
||||
else
|
||||
inc(p);
|
||||
end;
|
||||
' ',#9:
|
||||
inc(p);
|
||||
else
|
||||
break;
|
||||
end;
|
||||
until false;
|
||||
TokenStart:=p;
|
||||
case p^ of
|
||||
'a'..'z','A'..'Z','_':
|
||||
while p^ in ['a'..'z','A'..'Z','_','0'..'9'] do inc(p);
|
||||
'0'..'9':
|
||||
while p^ in ['0'..'9'] do inc(p);
|
||||
'''':
|
||||
begin
|
||||
inc(p);
|
||||
repeat
|
||||
case p^ of
|
||||
#0,#10,#13: break;
|
||||
'''':
|
||||
begin
|
||||
inc(p);
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
inc(p);
|
||||
until false;
|
||||
end;
|
||||
'/':
|
||||
if p[1]='/' then begin
|
||||
inc(p,2);
|
||||
while not (p^ in [#0,#10,#13]) do inc(p);
|
||||
end else
|
||||
inc(p);
|
||||
'{':
|
||||
begin
|
||||
inc(p);
|
||||
repeat
|
||||
case p^ of
|
||||
#0:
|
||||
if p-PChar(Src)=length(Src) then begin
|
||||
SrcP:=p;
|
||||
exit('');
|
||||
end;
|
||||
#10,#13:
|
||||
begin
|
||||
inc(Line);
|
||||
if (p[1] in [#10,#13]) and (p^<>p[1]) then
|
||||
inc(p);
|
||||
end;
|
||||
'}': break;
|
||||
end;
|
||||
inc(p);
|
||||
until false;
|
||||
inc(p);
|
||||
end;
|
||||
'(':
|
||||
if p[1]='*' then begin
|
||||
inc(p,2);
|
||||
repeat
|
||||
case p^ of
|
||||
#0:
|
||||
if p-PChar(Src)=length(Src) then begin
|
||||
SrcP:=p;
|
||||
exit('');
|
||||
end;
|
||||
#10,#13:
|
||||
begin
|
||||
inc(Line);
|
||||
if (p[1] in [#10,#13]) and (p^<>p[1]) then
|
||||
inc(p);
|
||||
end;
|
||||
'*':
|
||||
if p[1]=')' then break;
|
||||
end;
|
||||
inc(p);
|
||||
until false;
|
||||
inc(p,2);
|
||||
end else
|
||||
inc(p);
|
||||
else
|
||||
inc(p);
|
||||
end;
|
||||
SetLength(Result,p-TokenStart);
|
||||
Move(TokenStart^,Result[1],length(Result));
|
||||
SrcP:=P;
|
||||
end;
|
||||
|
||||
procedure GetLineStartEndAtPosition(const Source:string; Position:integer;
|
||||
out LineStart,LineEnd:integer);
|
||||
begin
|
||||
if Position<1 then begin
|
||||
LineStart:=0;
|
||||
LineEnd:=0;
|
||||
exit;
|
||||
end;
|
||||
if Position>length(Source)+1 then begin
|
||||
LineStart:=length(Source)+1;
|
||||
LineEnd:=LineStart;
|
||||
exit;
|
||||
end;
|
||||
LineStart:=Position;
|
||||
while (LineStart>1) and (not (Source[LineStart-1] in [#10,#13])) do
|
||||
dec(LineStart);
|
||||
LineEnd:=Position;
|
||||
while (LineEnd<=length(Source)) and (not (Source[LineEnd] in [#10,#13])) do
|
||||
inc(LineEnd);
|
||||
end;
|
||||
|
||||
function GetLineInSrc(const Source: string; Position: integer): string;
|
||||
var
|
||||
LineStart, LineEnd: integer;
|
||||
begin
|
||||
GetLineStartEndAtPosition(Source,Position,LineStart,LineEnd);
|
||||
Result:=copy(Source,LineStart,LineEnd-LineStart);
|
||||
end;
|
||||
|
||||
function CheckFile(Filename: string; const Log: TFindWritelnLog): integer;
|
||||
var
|
||||
Token, LastToken, Src: String;
|
||||
ms: TMemoryStream;
|
||||
p: PChar;
|
||||
Line, LastIFDEF, AllowWriteln: Integer;
|
||||
Lvl, VerboseLvl: integer;
|
||||
begin
|
||||
Result:=0;
|
||||
ms:=TMemoryStream.Create;
|
||||
try
|
||||
ms.LoadFromFile(Filename);
|
||||
if ms.Size=0 then exit;
|
||||
Src:='';
|
||||
SetLength(Src,ms.Size);
|
||||
Move(ms.Memory^,Src[1],length(Src));
|
||||
p:=PChar(Src);
|
||||
AllowWriteln:=0;
|
||||
Line:=1;
|
||||
LastIFDEF:=-1;
|
||||
Token:='';
|
||||
Lvl:=0;
|
||||
VerboseLvl:=-1;
|
||||
repeat
|
||||
LastToken:=Token;
|
||||
Token:=ReadNextToken(Src,p,Line);
|
||||
if Token='' then break;
|
||||
if Token[1]='{' then begin
|
||||
Token:=lowercase(Token);
|
||||
if Token='{allowwriteln}' then begin
|
||||
if AllowWriteln>0 then begin
|
||||
inc(Result);
|
||||
Log(etError,Filename+'('+IntToStr(Line)+'): writeln already allowed at '+IntToStr(AllowWriteln)+': '+GetLineInSrc(Src,p-PChar(Src)+1));
|
||||
end;
|
||||
AllowWriteln:=Line;
|
||||
end
|
||||
else if Token='{allowwriteln-}' then begin
|
||||
if AllowWriteln<1 then begin
|
||||
inc(Result);
|
||||
Log(etError,Filename+'('+IntToStr(Line)+'): writeln was not allowed: '+GetLineInSrc(Src,p-PChar(Src)+1));
|
||||
end;
|
||||
AllowWriteln:=0;
|
||||
end
|
||||
else if SameText(LeftStr(Token,4),'{$if') then begin
|
||||
inc(Lvl);
|
||||
LastIFDEF:=Line;
|
||||
if SameText(LeftStr(Token,15),'{$ifdef Verbose') then begin
|
||||
if VerboseLvl<0 then VerboseLvl:=Lvl;
|
||||
end;
|
||||
end else if SameText(LeftStr(Token,6),'{$else') then begin
|
||||
if Lvl=VerboseLvl then
|
||||
VerboseLvl:=-1;
|
||||
LastIFDEF:=Line;
|
||||
end else if SameText(LeftStr(Token,7),'{$endif') then begin
|
||||
if Lvl=VerboseLvl then begin
|
||||
VerboseLvl:=-1;
|
||||
end;
|
||||
dec(Lvl);
|
||||
end;
|
||||
end
|
||||
else begin
|
||||
if (CompareText(Token,'str')=0) and (LastToken<>'.') then begin
|
||||
if byte(Line-LastIFDEF) in [0,1] then begin
|
||||
// ignore writeln just behind IFDEF
|
||||
LastIFDEF:=Line;
|
||||
end;
|
||||
end;
|
||||
if (CompareText(Token,'writeln')=0)
|
||||
and (LastToken<>'.')
|
||||
and (LastToken<>':=')
|
||||
and (LastToken<>'=')
|
||||
and (LastToken<>'+')
|
||||
and not SameText(LastToken,'function')
|
||||
and not SameText(LastToken,'procedure') then begin
|
||||
if Lvl=VerboseLvl then begin
|
||||
// ignore writeln inside $IFDEF VerboseX
|
||||
end else if byte(Line-LastIFDEF) in [0,1] then begin
|
||||
// ignore writeln just behind IFDEF
|
||||
LastIFDEF:=Line;
|
||||
end else if AllowWriteln<1 then begin
|
||||
inc(Result);
|
||||
Log(etError,Filename+'('+IntToStr(Line)+'): '+GetLineInSrc(Src,p-PChar(Src)+1));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
until false;
|
||||
finally
|
||||
ms.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function FindWritelnInDirectory(Dir: string; Recurse: boolean; const Log: TFindWritelnLog): integer;
|
||||
var
|
||||
Info: TRawByteSearchRec;
|
||||
Ext: String;
|
||||
begin
|
||||
Result:=0;
|
||||
Dir:=IncludeTrailingPathDelimiter(Dir);
|
||||
if FindFirst(Dir+AllFilesMask,faAnyFile,Info)=0 then begin
|
||||
repeat
|
||||
if (Info.Name='') or (Info.Name='.') or (Info.Name='..') then continue;
|
||||
if (Info.Attr and faDirectory)>0 then begin
|
||||
if Recurse then
|
||||
Result+=FindWritelnInDirectory(Dir+Info.Name,true,Log);
|
||||
end
|
||||
else begin
|
||||
Ext:=lowercase(ExtractFileExt(Info.Name));
|
||||
case Ext of
|
||||
'.p','.pp','.pas','.inc': Result+=CheckFile(Dir+Info.Name,Log);
|
||||
end;
|
||||
end;
|
||||
until FindNext(Info)<>0;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user