From 1cdf78f1e3071222053f73739250d5a8cc391d93 Mon Sep 17 00:00:00 2001 From: "Artem V. Ageev" Date: Mon, 13 Jan 2025 21:40:36 +0200 Subject: [PATCH 1/7] Rewrote CI to Pascal --- .github/workflows/make.pas | 152 +++++++++++++++++++++++++++++++++++++ .github/workflows/make.yml | 20 +---- make.ps1 | 123 ------------------------------ make.sh | 86 --------------------- use/components.txt | 1 - 5 files changed, 156 insertions(+), 226 deletions(-) create mode 100644 .github/workflows/make.pas delete mode 100644 make.ps1 delete mode 100644 make.sh delete mode 100644 use/components.txt diff --git a/.github/workflows/make.pas b/.github/workflows/make.pas new file mode 100644 index 0000000..602e2dd --- /dev/null +++ b/.github/workflows/make.pas @@ -0,0 +1,152 @@ +program Make; +{$mode objfpc}{$H+} + +uses + Classes, + SysUtils, + StrUtils, + FileUtil, + Zipper, + fphttpclient, + openssl, + opensslsockets, + Process; + +const + Src: string = 'src'; + Use: string = 'use'; + Tst: string = 'testconsole.lpi'; + Pkg: array of string = ('UniqueInstance'); + +var + Output, Line: ansistring; + List: TStringList; + Each, Item, PackagePath, TempFile, Url: string; + 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') + else + begin + ExitCode += 1; + Writeln(#27'[31m', 'added ', Each, #27'[0m'); + end; + finally + List.Free; + end; + for Each in Pkg do + 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; + end; + end; + Zip.Free; + CreateDir(PackagePath); + with TUnZipper.Create do + begin + try + FileName := TempFile; + OutputPath := PackagePath; + Examine; + UnZipAllFiles; + WriteLn('Unzip from ', TempFile, ' to ', PackagePath); + finally + Free; + 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'); + end; + finally + List.Free; + end; + end; + end; + List := FindAllFiles('.', Tst, True); + try + for Each in List do + begin + Writeln(#27'[33m', 'build ', 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 + begin + if not RunCommand('command', [SplitString(Line, ' ')[2], + '--all', '--format=plain', '--progress'], Output) then + ExitCode += 1; + WriteLn(Output); + 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'); + end; + finally + List.Free; + end; + 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 + begin + ExitCode += 1; + for Line in SplitString(Output, LineEnding) do + if Pos('Fatal:', Line) <> 0 or Pos('Error:', Line) then + begin + WriteLn(); + Writeln(#27'[31m', Line, #27'[0m'); + end; + end; + end; + finally + List.Free; + end; +end. diff --git a/.github/workflows/make.yml b/.github/workflows/make.yml index 213e35f..a90dc85 100644 --- a/.github/workflows/make.yml +++ b/.github/workflows/make.yml @@ -24,26 +24,14 @@ jobs: matrix: os: - ubuntu-latest - - windows-latest steps: - name: Checkout uses: actions/checkout@v4 with: submodules: true - - name: Build on Linux - if: runner.os == 'Linux' + - name: Build shell: bash - run: bash make.sh build - - - name: Build on Windows - if: runner.os == 'Windows' - shell: powershell - run: pwsh -File make.ps1 build - - - name: Archive - if: runner.os == 'Windows' - uses: actions/upload-artifact@v4 - with: - retention-days: 1 - path: src\bin\*.exe + 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 diff --git a/make.ps1 b/make.ps1 deleted file mode 100644 index de8f285..0000000 --- a/make.ps1 +++ /dev/null @@ -1,123 +0,0 @@ -#!/usr/bin/env pwsh -############################################################################################################## - -Function Show-Usage { - " -Usage: pwsh -File $($PSCommandPath) [OPTIONS] -Options: - build Build program -" | Out-Host -} - -Function Request-File { - While ($Input.MoveNext()) { - $VAR = @{ - Uri = $Input.Current - OutFile = (Split-Path -Path $Input.Current -Leaf).Split('?')[0] - } - Invoke-WebRequest @VAR - Return $VAR.OutFile - } -} - -Function Install-Program { - While ($Input.MoveNext()) { - Switch ((Split-Path -Path $Input.Current -Leaf).Split('.')[-1]) { - 'msi' { - & msiexec /passive /package $Input.Current | Out-Null - } - Default { - & ".\$($Input.Current)" /SP- /VERYSILENT /SUPPRESSMSGBOXES /NORESTART | Out-Null - } - } - Remove-Item $Input.Current - } -} - -Function Build-Project { - @( - @{ - Cmd = 'lazbuild' - Url = 'https://fossies.org/windows/misc/lazarus-3.6-fpc-3.2.2-win64.exe' - Path = "C:\Lazarus" - } - ) | Where-Object { ! (Test-Path -Path $_.Path) } | - ForEach-Object { - $_.Url | Request-File | Install-Program - $Env:PATH+=";$($_.Path)" - (Get-Command $_.Cmd).Source | Out-Host - } - If (Test-Path -Path '.gitmodules') { - & git submodule update --init --recursive --force --remote | Out-Host - ".... [[$($LastExitCode)]] git submodule update" | Out-Host - } - $Env:Src = 'src' - $Env:Use = 'use' - $Env:Pkg = 'use\components.txt' - If (Test-Path -Path $Env:Use) { - If (Test-Path -Path $Env:Pkg) { - Get-Content -Path $Env:Pkg | - Where-Object { - ! (Test-Path -Path "$($Env:Use)\$($_)") && - ! (& lazbuild --verbose-pkgsearch $_ ) && - ! (& lazbuild --add-package $_) - } | ForEach-Object { - Return @{ - Uri = "https://packages.lazarus-ide.org/$($_).zip" - Path = "$($Env:Use)\$($_)" - OutFile = (New-TemporaryFile).FullName - } - } | ForEach-Object -Parallel { - Invoke-WebRequest -OutFile $_.OutFile -Uri $_.Uri - Expand-Archive -Path $_.OutFile -DestinationPath $_.Path - Remove-Item $_.OutFile - Return ".... download $($_.Uri)" - } | Out-Host - } - (Get-ChildItem -Filter '*.lpk' -Recurse -File –Path $Env:Use).FullName | - ForEach-Object { - & lazbuild --add-package-link $_ | Out-Null - Return ".... [$($LastExitCode)] add package link $($_)" - } | Out-Host - } - If (Test-Path -Path $Env:Src) { - Exit ( - (Get-ChildItem -Filter '*.lpi' -Recurse -File –Path $Env:Src).FullName | - Sort-Object | - ForEach-Object { - $error = 0 - $Output = (& lazbuild --build-all --recursive --no-write-project --build-mode='release' $_) - $Result = @(".... [$($LastExitCode)] build project $($_)") - If ($LastExitCode -eq 0) { - $Result += $Output | Select-String -Pattern 'Linking' - } Else { - $error = 1 - $Result += $Output | Select-String -Pattern 'Error:', 'Fatal:' - } - $Result | Out-Host - Return $error - } | Measure-Object -Sum - ).Sum - } -} - -Function Switch-Action { - $ErrorActionPreference = 'stop' - Set-PSDebug -Strict #-Trace 1 - Invoke-ScriptAnalyzer -EnableExit -Path $PSCommandPath - If ($args.count -gt 0) { - Switch ($args[0]) { - 'build' { - Build-Project - } - Default { - Show-Usage - } - } - } Else { - Show-Usage - } -} - -############################################################################################################## -Switch-Action @args | Out-Null diff --git a/make.sh b/make.sh deleted file mode 100644 index 79e34e1..0000000 --- a/make.sh +++ /dev/null @@ -1,86 +0,0 @@ -#!/usr/bin/env bash - -function priv_clippit -( - cat <&2 - fi - if [[ -d "${VAR[src]}" ]]; then - declare -i errors=0 - while read -r; do - declare -A TMP=( - [out]=$(mktemp) - ) - if (lazbuild --build-all --recursive --no-write-project --build-mode='release' "${REPLY}" > "${TMP[out]}"); then - printf '\x1b[32m\t[%s]\t%s\x1b[0m\n' "${?}" "${REPLY}" - grep --color='always' 'Linking' "${TMP[out]}" - else - printf '\x1b[31m\t[%s]\t%s\x1b[0m\n' "${?}" "${REPLY}" - grep --color='always' --extended-regexp '(Error|Fatal):' "${TMP[out]}" - ((errors+=1)) - fi 1>&2 - rm "${TMP[out]}" - done < <(find "${VAR[src]}" -type 'f' -name '*.lpi' | sort) - exit "${errors}" - fi -) - -function priv_main -( - set -euo pipefail - if ((${#})); then - case ${1} in - build) priv_lazbuild ;; - *) priv_clippit ;; - esac - else - priv_clippit - fi -) - -priv_main "${@}" >/dev/null diff --git a/use/components.txt b/use/components.txt deleted file mode 100644 index e4b46c2..0000000 --- a/use/components.txt +++ /dev/null @@ -1 +0,0 @@ -UniqueInstance From d2676be4b06eba396b682b2bca4a97e84fe33b96 Mon Sep 17 00:00:00 2001 From: "Artem V. Ageev" Date: Tue, 14 Jan 2025 21:07:23 +0200 Subject: [PATCH 2/7] del UniqueInstance --- .github/workflows/make.pas | 255 ++++++++++++++++++++++--------------- 1 file changed, 154 insertions(+), 101 deletions(-) diff --git a/.github/workflows/make.pas b/.github/workflows/make.pas index 602e2dd..341c984 100644 --- a/.github/workflows/make.pas +++ b/.github/workflows/make.pas @@ -1,4 +1,5 @@ program Make; +{$UNITPATH /usr/lib/lazarus/3.0/components/lazutils} {$mode objfpc}{$H+} uses @@ -14,139 +15,191 @@ const Src: string = 'src'; - Use: string = 'use'; + Use: string = 'src'; Tst: string = 'testconsole.lpi'; - Pkg: array of string = ('UniqueInstance'); + 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 + if Pos('Fatal:', Line) <> 0 or Pos('Error:', Line) then + begin + WriteLn(stderr); + Writeln(stderr, #27'[31m', Line, #27'[0m'); + 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 + if Pos('Fatal:', Line) <> 0 or Pos('Error:', Line) then begin - WriteLn(); - Writeln(#27'[31m', Line, #27'[0m'); + WriteLn(stderr); + Writeln(stderr, #27'[31m', Line, #27'[0m'); 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. From cefefdf34750435f9f70dd5fa2632468699e3630 Mon Sep 17 00:00:00 2001 From: "Artem V. Ageev" Date: Thu, 16 Jan 2025 14:35:49 +0200 Subject: [PATCH 3/7] fix github-actions --- .github/workflows/make.pas | 297 +++++++++++++++++++------------------ 1 file changed, 149 insertions(+), 148 deletions(-) diff --git a/.github/workflows/make.pas b/.github/workflows/make.pas index 341c984..c332d7a 100644 --- a/.github/workflows/make.pas +++ b/.github/workflows/make.pas @@ -1,5 +1,4 @@ program Make; -{$UNITPATH /usr/lib/lazarus/3.0/components/lazutils} {$mode objfpc}{$H+} uses @@ -9,197 +8,199 @@ FileUtil, Zipper, fphttpclient, + RegExpr, openssl, opensslsockets, Process; const - Src: string = 'src'; - Use: string = 'src'; - Tst: string = 'testconsole.lpi'; - Pkg: array of string = (); + Target: string = 'src'; + Dependencies: array of string = (); type Output = record - Code: integer; + Code: boolean; Output: ansistring; end; -var - Each, Item, PackagePath, TempFile, Url: string; - Line: ansistring; - Answer: Output; - List: TStringList; - Zip: TStream; - - procedure CheckModules; + procedure OutLog(Knd: string, Msg: string); 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(stderr, #27'[31m', Answer.Output, #27'[0m'); - end; + if Knd = 'error' then + Writeln(stderr, #27'[31m', Msg, #27'[0m') + else if Knd = 'info' then + Writeln(stderr, #27'[32m', Msg, #27'[0m') + else if Knd = 'audit' + Writeln(stderr, #27'[33m', Msg, #27'[0m') end; - procedure AddPackage(Path: string); + function CheckModules: Output; begin - 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; - finally - List.Free; - end; + if FileExists('.gitmodules') then + if RunCommand('git', ['submodule', 'update', '--init', '--recursive', + '--force', '--remote'], Result.Output) then + OutLog('info', Result.Output); end; - procedure AddOPM; + function AddPackage(Path: string): Output; begin - InitSSLInterface; - for Each in Pkg do + with TRegExpr.Create do begin - PackagePath := + Expression := {$IFDEF MSWINDOWS} - GetEnvironmentVariable('APPDATA') + '\.lazarus\onlinepackagemanager\packages\' + '(cocoa|x11|_template)' {$ELSE} - GetEnvironmentVariable('HOME') + '/.lazarus/onlinepackagemanager/packages/' + '(cocoa|gdi|_template)' {$ENDIF} - + 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 + ; + if not Exec(Path) and RunCommand('lazbuild', ['--add-package-link', Path], + Result.Output) then + OutLog('audit', 'added ' + Path); + Free; + end; + end; + + function BuildProject(Path: string): Output; + var + Line: string; + begin + OutLog('audit', 'build from ' + Path); + try + Result.Code := RunCommand('lazbuild', ['--build-all', '--recursive', + '--no-write-project', Path], Result.Output); + if Result.Code then + for Line in SplitString(Result.Output, LineEnding) 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; + if ContainsStr(Line, 'Linking') then + begin + Result.Output := SplitString(Line, ' ')[2]; + OutLog('info', ' to ' + Result.Output); + break; end; - end; - Zip.Free; - CreateDir(PackagePath); - with TUnZipper.Create do - begin - try - FileName := TempFile; - OutputPath := PackagePath; - Examine; - UnZipAllFiles; - WriteLn(stderr, 'Unzip from ', TempFile, ' to ', PackagePath); - finally + end + else + begin + ExitCode += 1; + for Line in SplitString(Result.Output, LineEnding) do + with TRegExpr.Create do + begin + Expression := '(Fatal|Error):'; + if Exec(Line) then + OutLog('error', #10 + Line); Free; end; - end; - DeleteFile(TempFile); - AddPackage(PackagePath); end; + except + on E: Exception do + OutLog('error', E.ClassName + #13#10 + E.Message); end; end; - procedure BuildProject(Path: string); + function RunTest(Path: string): Output; + var + Temp: string; begin - Write(stderr, #27'[33m', 'build from ', Each, #27'[0m'); - try - if RunCommand('lazbuild', ['--build-all', '--recursive', - '--no-write-project', Each], Answer.Output) then - Answer.Code := 0 - else + Result := BuildProject(Path); + Temp:= Result.Output; + if Result.Code then + try + if not RunCommand(Temp, ['--all', '--format=plain', '--progress'], Result.Output) then + begin + ExitCode += 1; + OutLog('error', Result.Output); + end; + except + on E: Exception do + OutLog('error', E.ClassName + #13#10 + E.Message); + end; + end; + + function InstallOPM(Each: string): string; + var + OutFile, Url: string; + Zip: TStream; + begin + Result := + {$IFDEF MSWINDOWS} + GetEnvironmentVariable('APPDATA') + '\.lazarus\onlinepackagemanager\packages\' + {$ELSE} + GetEnvironmentVariable('HOME') + '/.lazarus/onlinepackagemanager/packages/' + {$ENDIF} + + Each; + OutFile := GetTempFileName; + Uri := 'https://packages.lazarus-ide.org/' + Each + '.zip'; + if not DirectoryExists(Result) then + begin + Zip := TFileStream.Create(OutFile, fmCreate or fmOpenWrite); + with TFPHttpClient.Create(nil) do begin - Answer.Code := 1; - ExitCode += Answer.Code; + try + AddHeader('User-Agent', 'Mozilla/5.0 (compatible; fpweb)'); + AllowRedirect := True; + Get(Uri, Zip); + OutLog('audit', 'Download from ' + Uri + ' to ' + OutFile); + finally + Free; + end; end; - except - on E: Exception do - WriteLn(stderr, 'Error: ' + E.ClassName + #13#10 + E.Message); + Zip.Free; + CreateDir(Result); + with TUnZipper.Create do + begin + try + FileName := OutFile; + OutputPath := Result; + Examine; + UnZipAllFiles; + OutLog('audit', 'Unzip from ' + OutFile + ' to ' + Result); + finally + Free; + end; + end; + DeleteFile(OutFile); end; end; - procedure RunTest; + procedure BuildAll; + var + Each, Item: string; + List: TStringList; begin - List := FindAllFiles('.', Tst, True); + CheckModules; + InitSSLInterface; + for Item in Dependencies do + begin + List := FindAllFiles(InstallOPM(Item), '*.lpk', True); + try + for Each in List do + AddPackage(Each); + finally + List.Free; + end; + end; + List := FindAllFiles(GetCurrentDir, '*.lpk', True); try for Each in List do - begin - BuildProject(Each); - if Answer.Code <> 0 then - begin - for Line in SplitString(Answer.Output, LineEnding) do - if Pos('Fatal:', Line) <> 0 or Pos('Error:', Line) then - begin - WriteLn(stderr); - Writeln(stderr, #27'[31m', Line, #27'[0m'); - end; - end + AddPackage(Each); + finally + List.Free; + end; + List := FindAllFiles(Target, '*.lpi', True); + try + for Each in List do + if ContainsStr(ReadFileToString(ReplaceStr(Each, '.lpi', '.lpr')), + 'consoletestrunner') then + RunTest(Each) 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; + BuildProject(Each); finally List.Free; end; + if ExitCode <> 0 then + OutLog('error', #10 + 'Errors: ' + ExitCode); + else + OutLog('info', #10 + 'Errors: ' + ExitCode); end; begin - CheckModules; - AddPackage(Use); - AddOPM; - {$IFDEF LINUX} - RunTest; - {$ENDIF} - List := FindAllFiles(Src, '*.lpi', True); - try - for Each in List do - if Pos(Tst, Each) = 0 then - begin - BuildProject(Each); - if Answer.Code <> 0 then - begin - for Line in SplitString(Answer.Output, LineEnding) do - if Pos('Fatal:', Line) <> 0 or Pos('Error:', Line) then - begin - WriteLn(stderr); - Writeln(stderr, #27'[31m', Line, #27'[0m'); - 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; - 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'); + BuildAll; end. From b5562a8aa4e8d3275997b27125a764bf2550e27c Mon Sep 17 00:00:00 2001 From: "Artem V. Ageev" Date: Thu, 16 Jan 2025 14:43:50 +0200 Subject: [PATCH 4/7] fix github-actions --- .github/workflows/make.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/make.pas b/.github/workflows/make.pas index c332d7a..dd2b227 100644 --- a/.github/workflows/make.pas +++ b/.github/workflows/make.pas @@ -30,7 +30,7 @@ Output = record else if Knd = 'info' then Writeln(stderr, #27'[32m', Msg, #27'[0m') else if Knd = 'audit' - Writeln(stderr, #27'[33m', Msg, #27'[0m') + Writeln(stderr, #27'[33m', Msg, #27'[0m'); end; function CheckModules: Output; From 66b2bcca511f9b4f81be59d9e8fd1ad1083c0661 Mon Sep 17 00:00:00 2001 From: "Artem V. Ageev" Date: Thu, 16 Jan 2025 15:05:00 +0200 Subject: [PATCH 5/7] fix github-actions --- .github/workflows/make.pas | 19 +++++++++---------- 1 file changed, 9 insertions(+), 10 deletions(-) diff --git a/.github/workflows/make.pas b/.github/workflows/make.pas index dd2b227..c71fdac 100644 --- a/.github/workflows/make.pas +++ b/.github/workflows/make.pas @@ -23,14 +23,13 @@ Output = record Output: ansistring; end; - procedure OutLog(Knd: string, Msg: string); + procedure OutLog(Knd: string; Msg: string); begin - if Knd = 'error' then - Writeln(stderr, #27'[31m', Msg, #27'[0m') - else if Knd = 'info' then - Writeln(stderr, #27'[32m', Msg, #27'[0m') - else if Knd = 'audit' - Writeln(stderr, #27'[33m', Msg, #27'[0m'); + 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: Output; @@ -116,7 +115,7 @@ Output = record function InstallOPM(Each: string): string; var - OutFile, Url: string; + OutFile, Uri: string; Zip: TStream; begin Result := @@ -196,9 +195,9 @@ Output = record List.Free; end; if ExitCode <> 0 then - OutLog('error', #10 + 'Errors: ' + ExitCode); + OutLog('error', #10 + 'Errors: ' + IntToStr(ExitCode)) else - OutLog('info', #10 + 'Errors: ' + ExitCode); + OutLog('info', #10 + 'Errors: ' + IntToStr(ExitCode)); end; begin From cfc869a6f3851e71f3820de1227d41a2ccbcdf27 Mon Sep 17 00:00:00 2001 From: "Artem V. Ageev" Date: Thu, 16 Jan 2025 15:23:06 +0200 Subject: [PATCH 6/7] add delp --- .github/workflows/make.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/make.yml b/.github/workflows/make.yml index a90dc85..808aaef 100644 --- a/.github/workflows/make.yml +++ b/.github/workflows/make.yml @@ -35,3 +35,4 @@ jobs: 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 + delp -vr "${PWD}" From 543ad460ac6217dae9f962f50e04c8d88200a1bc Mon Sep 17 00:00:00 2001 From: "Artem V. Ageev" Date: Thu, 16 Jan 2025 21:34:43 +0200 Subject: [PATCH 7/7] add Success --- .github/workflows/make.pas | 44 ++++++++++++++++++++------------------ .github/workflows/make.yml | 2 +- 2 files changed, 24 insertions(+), 22 deletions(-) diff --git a/.github/workflows/make.pas b/.github/workflows/make.pas index c71fdac..65bc1d4 100644 --- a/.github/workflows/make.pas +++ b/.github/workflows/make.pas @@ -18,17 +18,19 @@ Dependencies: array of string = (); type + TLog = (audit, info, error); Output = record - Code: boolean; - Output: ansistring; + Success: boolean; + Output: string; end; - procedure OutLog(Knd: string; Msg: string); + + procedure OutLog(Knd: TLog; 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'); + 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; @@ -37,7 +39,7 @@ Output = record if FileExists('.gitmodules') then if RunCommand('git', ['submodule', 'update', '--init', '--recursive', '--force', '--remote'], Result.Output) then - OutLog('info', Result.Output); + OutLog(info, Result.Output); end; function AddPackage(Path: string): Output; @@ -53,7 +55,7 @@ Output = record ; if not Exec(Path) and RunCommand('lazbuild', ['--add-package-link', Path], Result.Output) then - OutLog('audit', 'added ' + Path); + OutLog(audit, 'added ' + Path); Free; end; end; @@ -62,17 +64,17 @@ Output = record var Line: string; begin - OutLog('audit', 'build from ' + Path); + OutLog(audit, 'build from ' + Path); try - Result.Code := RunCommand('lazbuild', ['--build-all', '--recursive', + Result.Success := RunCommand('lazbuild', ['--build-all', '--recursive', '--no-write-project', Path], Result.Output); - if Result.Code then + if Result.Success then for Line in SplitString(Result.Output, LineEnding) do begin if ContainsStr(Line, 'Linking') then begin Result.Output := SplitString(Line, ' ')[2]; - OutLog('info', ' to ' + Result.Output); + OutLog(info, ' to ' + Result.Output); break; end; end @@ -84,13 +86,13 @@ Output = record begin Expression := '(Fatal|Error):'; if Exec(Line) then - OutLog('error', #10 + Line); + OutLog(error, #10 + Line); Free; end; end; except on E: Exception do - OutLog('error', E.ClassName + #13#10 + E.Message); + OutLog(error, E.ClassName + #13#10 + E.Message); end; end; @@ -100,16 +102,16 @@ Output = record begin Result := BuildProject(Path); Temp:= Result.Output; - if Result.Code then + if Result.Success then try if not RunCommand(Temp, ['--all', '--format=plain', '--progress'], Result.Output) then begin ExitCode += 1; - OutLog('error', Result.Output); + OutLog(error, Result.Output); end; except on E: Exception do - OutLog('error', E.ClassName + #13#10 + E.Message); + OutLog(error, E.ClassName + #13#10 + E.Message); end; end; @@ -136,7 +138,7 @@ Output = record AddHeader('User-Agent', 'Mozilla/5.0 (compatible; fpweb)'); AllowRedirect := True; Get(Uri, Zip); - OutLog('audit', 'Download from ' + Uri + ' to ' + OutFile); + OutLog(audit, 'Download from ' + Uri + ' to ' + OutFile); finally Free; end; @@ -150,7 +152,7 @@ Output = record OutputPath := Result; Examine; UnZipAllFiles; - OutLog('audit', 'Unzip from ' + OutFile + ' to ' + Result); + OutLog(audit, 'Unzip from ' + OutFile + ' to ' + Result); finally Free; end; @@ -195,9 +197,9 @@ Output = record List.Free; end; if ExitCode <> 0 then - OutLog('error', #10 + 'Errors: ' + IntToStr(ExitCode)) + OutLog(error, #10 + 'Errors: ' + IntToStr(ExitCode)) else - OutLog('info', #10 + 'Errors: ' + IntToStr(ExitCode)); + OutLog(info, #10 + 'Errors: ' + IntToStr(ExitCode)); end; begin diff --git a/.github/workflows/make.yml b/.github/workflows/make.yml index 808aaef..385d90d 100644 --- a/.github/workflows/make.yml +++ b/.github/workflows/make.yml @@ -35,4 +35,4 @@ jobs: 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 - delp -vr "${PWD}" + delp -r "${PWD}"