releasecreator: started

tools/releasecreator/.gitignore

@@ -0,0 +1 @@
+Pas2jsReleaseCreator

tools/releasecreator/Pas2jsReleaseCreator.lpi

@@ -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>

tools/releasecreator/Pas2jsReleaseCreator.lpr

@@ -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.
+

tools/releasecreator/findwriteln.pas

@@ -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.
+
+