Skip to content

Commit

Permalink
fix github-actions
Browse files Browse the repository at this point in the history
  • Loading branch information
theavege committed Jan 14, 2025
1 parent 2e18ae7 commit 4b3d374
Show file tree
Hide file tree
Showing 4 changed files with 166 additions and 103 deletions.
263 changes: 163 additions & 100 deletions .github/workflows/make.pas
Original file line number Diff line number Diff line change
Expand Up @@ -8,145 +8,208 @@
FileUtil,
Zipper,
fphttpclient,
RegExpr,
openssl,
opensslsockets,
Process;

const
Src: string = 'demos';
Use: string = 'Package';
Use: string = 'packages';
Tst: string = 'testconsole.lpi';
Pkg: array of string = ();

type
Output = record
Code: integer;
Output: ansistring;
end;

var
Output, Line: ansistring;
List: TStringList;
Each, Item, PackagePath, TempFile, Url: string;
Line: ansistring;
Answer: Output;
List: TStringList;
Zip: TStream;

begin
InitSSLInterface;
if FileExists('.gitmodules') then
if RunCommand('git', ['submodule', 'update', '--init', '--recursive',
'--force', '--remote'], Output) then
Writeln(#27'[33m', Output, #27'[0m')
else
begin
ExitCode += 1;
Writeln(#27'[31m', Output, #27'[0m');
end;
List := FindAllFiles(Use, '*.lpk', True);
try
for Each in List do
if RunCommand('lazbuild', ['--add-package-link', Each], Output) then
Writeln(#27'[33m', 'added ', Each, #27'[0m')
procedure CheckModules;
begin
if FileExists('.gitmodules') then
if RunCommand('git', ['submodule', 'update', '--init', '--recursive',
'--force', '--remote'], Answer.Output) then
Writeln(stderr, #27'[33m', Answer.Output, #27'[0m')
else
begin
ExitCode += 1;
Writeln(#27'[31m', 'added ', Each, #27'[0m');
Writeln(stderr, #27'[31m', Answer.Output, #27'[0m');
end;
finally
List.Free;
end;
for Each in Pkg do

procedure AddPackage(Path: string);
begin
PackagePath := GetEnvironmentVariable('HOME') +
'/.lazarus/onlinepackagemanager/packages/' + Each;
TempFile := GetTempFileName;
Url := 'https://packages.lazarus-ide.org/' + Each + '.zip';
if not DirectoryExists(PackagePath) then
begin
Zip := TFileStream.Create(TempFile, fmCreate or fmOpenWrite);
with TFPHttpClient.Create(nil) do
begin
try
AddHeader('User-Agent', 'Mozilla/5.0 (compatible; fpweb)');
AllowRedirect := True;
Get(Url, Zip);
WriteLn('Download from ', Url, ' to ', TempFile);
finally
Free;
List := FindAllFiles(Use, '*.lpk', True);
try
for Each in List do
if RunCommand('lazbuild', ['--add-package-link', Each], Answer.Output) then
Writeln(stderr, #27'[33m', 'added ', Each, #27'[0m')
else
begin
ExitCode += 1;
Writeln(stderr, #27'[31m', 'added ', Each, #27'[0m');
end;
end;
Zip.Free;
CreateDir(PackagePath);
with TUnZipper.Create do
finally
List.Free;
end;
end;

procedure AddOPM;
begin
InitSSLInterface;
for Each in Pkg do
begin
PackagePath :=
{$IFDEF MSWINDOWS}
GetEnvironmentVariable('APPDATA') + '\.lazarus\onlinepackagemanager\packages\'
{$ELSE}
GetEnvironmentVariable('HOME') + '/.lazarus/onlinepackagemanager/packages/'
{$ENDIF}
+ Each;
TempFile := GetTempFileName;
Url := 'https://packages.lazarus-ide.org/' + Each + '.zip';
if not DirectoryExists(PackagePath) then
begin
try
FileName := TempFile;
OutputPath := PackagePath;
Examine;
UnZipAllFiles;
WriteLn('Unzip from ', TempFile, ' to ', PackagePath);
finally
Free;
Zip := TFileStream.Create(TempFile, fmCreate or fmOpenWrite);
with TFPHttpClient.Create(nil) do
begin
try
AddHeader('User-Agent', 'Mozilla/5.0 (compatible; fpweb)');
AllowRedirect := True;
Get(Url, Zip);
WriteLn(stderr, 'Download from ', Url, ' to ', TempFile);
finally
Free;
end;
end;
end;
DeleteFile(TempFile);
List := FindAllFiles(PackagePath, '*.lpk', True);
try
for Item in List do
if RunCommand('lazbuild', ['--add-package-link', Item], Output) then
Writeln(#27'[33m', 'added ', Item, #27'[0m')
else
begin
ExitCode += 1;
Writeln(#27'[31m', 'added ', Item, #27'[0m');
Zip.Free;
CreateDir(PackagePath);
with TUnZipper.Create do
begin
try
FileName := TempFile;
OutputPath := PackagePath;
Examine;
UnZipAllFiles;
WriteLn(stderr, 'Unzip from ', TempFile, ' to ', PackagePath);
finally
Free;
end;
finally
List.Free;
end;
DeleteFile(TempFile);
AddPackage(PackagePath);
end;
end;
end;
List := FindAllFiles('.', Tst, True);
try
for Each in List do
begin
Writeln(#27'[33m', 'build ', Each, #27'[0m');

procedure BuildProject(Path: string);
begin
Write(stderr, #27'[33m', 'build from ', Each, #27'[0m');
try
if RunCommand('lazbuild', ['--build-all', '--recursive',
'--no-write-project', Each], Output) then
for Line in SplitString(Output, LineEnding) do
'--no-write-project', Each], Answer.Output) then
Answer.Code := 0
else
begin
Answer.Code := 1;
ExitCode += Answer.Code;
end;
except
on E: Exception do
WriteLn(stderr, 'Error: ' + E.ClassName + #13#10 + E.Message);
end;
end;

procedure RunTest;
begin
List := FindAllFiles('.', Tst, True);
try
for Each in List do
begin
BuildProject(Each);
if Answer.Code <> 0 then
begin
if Pos('Linking', Line) <> 0 then
begin
if not RunCommand('command', [SplitString(Line, ' ')[2],
'--all', '--format=plain', '--progress'], Output) then
ExitCode += 1;
WriteLn(Output);
end;
for Line in SplitString(Answer.Output, LineEnding) do
with TRegExpr.Create do
begin
Expression := '(Fatal|Error):';
if Exec(Line) then
begin
WriteLn(stderr);
Writeln(stderr, #27'[31m', Line, #27'[0m');
end;
Free;
end;
end
else
for Line in SplitString(Output, LineEnding) do
if Pos('Fatal', Line) <> 0 or Pos('Error', Line) then
Writeln(#27'[31m', Line, #27'[0m');
else
for Line in SplitString(Answer.Output, LineEnding) do
if Pos('Linking', Line) <> 0 then
try
begin
Writeln(stderr, #27'[32m', ' to ', SplitString(Line, ' ')[2], #27'[0m');
if not RunCommand(ReplaceStr(SplitString(Line, ' ')[2],
SplitString(Tst, '.')[0], './' + SplitString(Tst, '.')[0]),
['--all', '--format=plain', '--progress'], Answer.Output) then
ExitCode += 1;
WriteLn(stderr, Answer.Output);
break;
end;
except
on E: Exception do
WriteLn(stderr, 'Error: ' + E.ClassName + #13#10 + E.Message);
end;
end;
finally
List.Free;
end;
finally
List.Free;
end;

begin
CheckModules;
AddPackage(Use);
AddOPM;
{$IFDEF LINUX}
RunTest;
{$ENDIF}
List := FindAllFiles(Src, '*.lpi', True);
try
for Each in List do
begin
Write(#27'[33m', 'build from ', Each, #27'[0m');
if RunCommand('lazbuild', ['--build-all', '--recursive',
'--no-write-project', Each], Output) then
for Line in SplitString(Output, LineEnding) do
begin
if Pos('Linking', Line) <> 0 then
Writeln(#27'[32m', ' to ', SplitString(Line, ' ')[2], #27'[0m');
end
else
if Pos(Tst, Each) = 0 then
begin
ExitCode += 1;
for Line in SplitString(Output, LineEnding) do
if Pos('Fatal:', Line) <> 0 or Pos('Error:', Line) then
BuildProject(Each);
if Answer.Code <> 0 then
begin
for Line in SplitString(Answer.Output, LineEnding) do
with TRegExpr.Create do
begin
WriteLn();
Writeln(#27'[31m', Line, #27'[0m');
Expression := '(Fatal|Error):';
if Exec(Line) then
begin
WriteLn(stderr);
Writeln(stderr, #27'[31m', Line, #27'[0m');
end;
Free;
end;
end
else
for Line in SplitString(Answer.Output, LineEnding) do
if Pos('Linking', Line) <> 0 then
Writeln(stderr, #27'[32m', ' to ', SplitString(Line, ' ')[2], #27'[0m');
end;
end;
finally
List.Free;
end;
WriteLn(stderr);
if ExitCode <> 0 then
WriteLn(stderr, #27'[31m', 'Errors: ', ExitCode, #27'[0m')
else
WriteLn(stderr, #27'[32m', 'Errors: ', ExitCode, #27'[0m');
end.
2 changes: 1 addition & 1 deletion .github/workflows/make.yml
Original file line number Diff line number Diff line change
Expand Up @@ -34,4 +34,4 @@ jobs:
shell: bash
run: |
sudo bash -c 'apt-get update; apt-get install -y lazarus' >/dev/null
instantfpc "-Fu/usr/lib/lazarus/3.0/components/lazutils" .github/workflows/make.pas
instantfpc -Fu/usr/lib/lazarus/*/components/lazutils .github/workflows/make.pas
2 changes: 1 addition & 1 deletion packages/brookframework

0 comments on commit 4b3d374

Please sign in to comment.