Skip to content

Commit

Permalink
Rewrote CI to Pascal (#3)
Browse files Browse the repository at this point in the history
  • Loading branch information
theavege authored Jan 19, 2025
1 parent 212616d commit bae3111
Show file tree
Hide file tree
Showing 6 changed files with 208 additions and 315 deletions.
7 changes: 0 additions & 7 deletions .github/workflows/make.json

This file was deleted.

185 changes: 185 additions & 0 deletions .github/workflows/make.pas
Original file line number Diff line number Diff line change
@@ -0,0 +1,185 @@
program Make;
{$mode objfpc}{$H+}
{$unitpath /usr/lib64/lazarus/components/lazutils}
uses
Classes,
SysUtils,
StrUtils,
FileUtil,
Zipper,
fphttpclient,
RegExpr,
openssl,
opensslsockets,
Process;

const
Target: string = 'IntXLib.Tests';
Dependencies: array of string = ();

type
TLog = (audit, info, error);

Output = record
Success: boolean;
Output: string;
end;

procedure OutLog(const Knd: TLog; const Msg: string);
begin
case Knd of
error: Writeln(stderr, #27'[31m', Msg, #27'[0m');
info: Writeln(stderr, #27'[32m', Msg, #27'[0m');
audit: Writeln(stderr, #27'[33m', Msg, #27'[0m');
end;
end;

function CheckModules: string;
begin
if FileExists('.gitmodules') then
if RunCommand('git', ['submodule', 'update', '--init', '--recursive',
'--force', '--remote'], Result) then
OutLog(info, Result)
else
OutLog(error, Result);
end;

function AddPackage(const Path: string): string;
begin
if RunCommand('lazbuild', ['--add-package-link', Path], Result) then
OutLog(audit, #9 + Path);
end;

function SelectString(const Input, Reg: string): string;
var
Line: string;
begin
Result := ' ';
for Line in Input.Split(LineEnding) do
with TRegExpr.Create do
begin
Expression := Reg;
if Exec(Line) then
Result += Line + LineEnding;
Free;
end;
end;

function RunTest(const Path: String): string;
begin
OutLog(audit, #9'run:'#9 + Path);
if RunCommand(Path, ['--all', '--format=plain'], Result) then
OutLog(info, #9'success!')
else
ExitCode += 1;
OutLog(audit, Result);
end;

function BuildProject(const Path: string): Output;
begin
OutLog(audit, 'Build from:'#9 + Path);
Result.Success := RunCommand('lazbuild',
['--build-all', '--recursive', '--no-write-project', Path], Result.Output);
Result.Output := SelectString(Result.Output, '(Fatal:|Error:|Linking)');
if Result.Success then
begin
Result.Output := Result.Output.Split(' ')[3].Replace(LineEnding, '');
OutLog(info, #9'to:'#9 + Result.Output);
if ContainsStr(ReadFileToString(Path.Replace('.lpi', '.lpr')), 'consoletestrunner') then
RunTest(Result.Output.Replace(#10, ''));
end
else
begin
ExitCode += 1;
OutLog(error, Result.Output);
end;
end;

function DownloadFile(const Uri: string): string;
var
OutFile: TStream;
begin
InitSSLInterface;
Result := GetTempFileName;
OutFile := TFileStream.Create(Result, fmCreate or fmOpenWrite);
with TFPHttpClient.Create(nil) do
begin
try
AddHeader('User-Agent', 'Mozilla/5.0 (compatible; fpweb)');
AllowRedirect := True;
Get(Uri, OutFile);
OutLog(audit, 'Download from ' + Uri + ' to ' + Result);
finally
Free;
OutFile.Free;
end;
end;
end;

procedure UnZip(const ZipFile, ZipPath: string);
begin
with TUnZipper.Create do
begin
try
FileName := ZipFile;
OutputPath := ZipPath;
Examine;
UnZipAllFiles;
OutLog(audit, 'Unzip from'#9 + ZipFile + #9'to'#9 + ZipPath);
DeleteFile(ZipFile);
finally
Free;
end;
end;
end;

function InstallOPM(const Path: string): string;
begin
Result :=
{$IFDEF MSWINDOWS}
GetEnvironmentVariable('APPDATA') + '\.lazarus\onlinepackagemanager\packages\'
{$ELSE}
GetEnvironmentVariable('HOME') + '/.lazarus/onlinepackagemanager/packages/'
{$ENDIF}
+ Path;
if not DirectoryExists(Result) then
begin
CreateDir(Result);
UnZip(DownloadFile('https://packages.lazarus-ide.org/' + Path + '.zip'), Result);
end;
end;

function BuildAll: string;
var
List: TStringList;
begin
CheckModules;
List := FindAllFiles(GetCurrentDir, '*.lpk', True);
try
for Result in Dependencies do
List.AddStrings(FindAllFiles(InstallOPM(Result), '*.lpk', True));
if List.Count <> 0 then
OutLog(audit, 'Add packages:'#9 + IntToStr(List.Count));
for Result in List do
AddPackage(Result);
List := FindAllFiles(Target, '*.lpi', True);
for Result in List do
BuildProject(Result);
finally
List.Free;
end;
case ExitCode of
0: OutLog(info, 'Errors:'#9 + IntToStr(ExitCode));
else
OutLog(error, 'Errors:'#9 + IntToStr(ExitCode));
end;
end;

begin
try
BuildAll
except
on E: Exception do
Writeln(E.ClassName, #9, E.Message);
end;
end.
187 changes: 0 additions & 187 deletions .github/workflows/make.ps1

This file was deleted.

Loading

0 comments on commit bae3111

Please sign in to comment.