From 2e18ae7847460f312d11df7f4151fde2fea6a263 Mon Sep 17 00:00:00 2001 From: "Artem V. Ageev" Date: Mon, 13 Jan 2025 21:24:54 +0200 Subject: [PATCH 1/7] Rewrote CI to Pascal --- .github/workflows/make.pas | 152 +++++++++++++++++++++++++++++++++ .github/workflows/make.ps1 | 167 ------------------------------------- .github/workflows/make.sh | 98 ---------------------- .github/workflows/make.yml | 20 +---- 4 files changed, 156 insertions(+), 281 deletions(-) create mode 100644 .github/workflows/make.pas delete mode 100644 .github/workflows/make.ps1 delete mode 100644 .github/workflows/make.sh diff --git a/.github/workflows/make.pas b/.github/workflows/make.pas new file mode 100644 index 0000000..56bce0a --- /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 = 'demos'; + Use: string = 'Package'; + Tst: string = 'testconsole.lpi'; + Pkg: array of string = (); + +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.ps1 b/.github/workflows/make.ps1 deleted file mode 100644 index 63f4ae3..0000000 --- a/.github/workflows/make.ps1 +++ /dev/null @@ -1,167 +0,0 @@ -#!/usr/bin/env pwsh -############################################################################################################## - -Function Show-Usage { - " -vagrant = 'it-gro/win10-ltsc-eval' -download = 'https://microsoft.com/en-us/evalcenter' -package = 'https://learn.microsoft.com/en-us/mem/configmgr/develop/apps/how-to-create-the-windows-installer-file-msi' -shell = 'https://learn.microsoft.com/en-us/powershell' - -Usage: pwsh -File $($PSCommandPath) [OPTIONS] -Options: - build - lint -" | Out-Host -} - -Function Build-Project { - New-Variable -Option Constant -Name VAR -Value @{ - Src = 'demos' - Use = 'packages' - Pkg = 'packages\components.txt' - } - If (! (Test-Path -Path $Var.Src)) { - 'Source do not find!' | Out-Host - Exit 1 - } - If (Test-Path -Path '.gitmodules') { - & git submodule update --init --recursive --force --remote | Out-Host - ".... [[$($LastExitCode)]] git submodule update" | Out-Host - } - @( - @{ - 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 $VAR.Use) { - If (Test-Path -Path $VAR.Pkg) { - Get-Content -Path $VAR.Pkg | - Where-Object { - ! (Test-Path -Path "$($VAR.Use)\$($_)") && - ! (& lazbuild --verbose-pkgsearch $_ ) && - ! (& lazbuild --add-package $_) - } | ForEach-Object { - Return @{ - Uri = "https://packages.lazarus-ide.org/$($_).zip" - Path = "$($VAR.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 $VAR.Use).FullName | - ForEach-Object { - & lazbuild --add-package-link $_ | Out-Null - Return ".... [$($LastExitCode)] add package link $($_)" - } | Out-Host - } - Exit ( - (Get-ChildItem -Filter '*.lpi' -Recurse -File –Path $Var.Src).FullName | - Sort-Object | - ForEach-Object { - $Output = (& lazbuild --build-all --recursive --no-write-project $_) - $Result = @(".... [$($LastExitCode)] build project $($_)") - $exitCode = Switch ($LastExitCode) { - 0 { - $Result += $Output | Select-String -Pattern 'Linking' - 0 - } - Default { - $Result += $Output | Select-String -Pattern 'Error:', 'Fatal:' - 1 - } - } - $Result | Out-Host - Return $exitCode - } | Measure-Object -Sum - ).Sum -} - -Function Request-File { - While ($Input.MoveNext()) { - New-Variable -Option Constant -Name VAR -Value @{ - 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 Request-URL([Switch] $Post) { - $VAR = Switch ($Post) { - True { - Return @{ - Method = 'POST' - Headers = @{ - ContentType = 'application/json' - } - Uri = 'https://postman-echo.com/post' - Body = @{ - One = '1' - } | ConvertTo-Json - } - } - False { - Return @{ - Uri = 'https://postman-echo.com/get' - } - } - } - Return (Invoke-WebRequest @VAR | ConvertFrom-Json).Headers -} - -Function Switch-Action { - $ErrorActionPreference = 'stop' - Set-PSDebug -Strict #-Trace 1 - Invoke-ScriptAnalyzer -EnableExit -Path $PSCommandPath - If ($args.count -gt 0) { - Switch ($args[0]) { - 'lint' { - Invoke-ScriptAnalyzer -EnableExit -Recurse -Path '.' - (Get-ChildItem -Filter '*.ps1' -Recurse -Path '.').FullName | - ForEach-Object { - Invoke-Formatter -ScriptDefinition $(Get-Content -Path $_ | Out-String) | - Set-Content -Path $_ - } - } - 'build' { - Build-Project - } - Default { - Show-Usage - } - } - } Else { - Show-Usage - } -} - -############################################################################################################## -Switch-Action @args diff --git a/.github/workflows/make.sh b/.github/workflows/make.sh deleted file mode 100644 index 0d1b486..0000000 --- a/.github/workflows/make.sh +++ /dev/null @@ -1,98 +0,0 @@ -#!/usr/bin/env bash -############################################################################################################## - -function priv_clippit -( - cat <&2 - fi - declare -i errors=0 - while read -r; do - declare -A TMP=( - [out]=$(mktemp) - ) - if (lazbuild --build-all --recursive --no-write-project "${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}" -) - -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/.github/workflows/make.yml b/.github/workflows/make.yml index 006d55c..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 .github/workflows/make.sh build - - - name: Build on Windows - if: runner.os == 'Windows' - shell: powershell - run: pwsh -File .github/workflows/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 From 4b3d3742425e83fad5676b2906af60e09c9f11af Mon Sep 17 00:00:00 2001 From: "Artem V. Ageev" Date: Tue, 14 Jan 2025 22:03:54 +0200 Subject: [PATCH 2/7] fix github-actions --- .github/workflows/make.pas | 263 +++++++++++++++++++++++-------------- .github/workflows/make.yml | 2 +- packages/brookframework | 2 +- packages/dopf | 2 +- 4 files changed, 166 insertions(+), 103 deletions(-) diff --git a/.github/workflows/make.pas b/.github/workflows/make.pas index 56bce0a..57bd54d 100644 --- a/.github/workflows/make.pas +++ b/.github/workflows/make.pas @@ -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. diff --git a/.github/workflows/make.yml b/.github/workflows/make.yml index a90dc85..b469b76 100644 --- a/.github/workflows/make.yml +++ b/.github/workflows/make.yml @@ -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 diff --git a/packages/brookframework b/packages/brookframework index 9d7b784..9cfd284 160000 --- a/packages/brookframework +++ b/packages/brookframework @@ -1 +1 @@ -Subproject commit 9d7b784ae7a4ff52485487d53d4a4c02bb667fa1 +Subproject commit 9cfd28410e562a51fafde3bdf1fd5fca24c9c2e2 diff --git a/packages/dopf b/packages/dopf index c103bc5..de1e462 160000 --- a/packages/dopf +++ b/packages/dopf @@ -1 +1 @@ -Subproject commit c103bc5287b199d4c98f042cd18fa2f9ff91afb8 +Subproject commit de1e462e4fb666c34199a95d41ce84ac280ac119 From b639eacf53b222289e805def1bcb16dfd8e01640 Mon Sep 17 00:00:00 2001 From: "Artem V. Ageev" Date: Wed, 15 Jan 2025 20:37:43 +0200 Subject: [PATCH 3/7] fix github-actions --- .github/workflows/make.pas | 299 +++++++++++++++++-------------------- 1 file changed, 141 insertions(+), 158 deletions(-) diff --git a/.github/workflows/make.pas b/.github/workflows/make.pas index 57bd54d..374d520 100644 --- a/.github/workflows/make.pas +++ b/.github/workflows/make.pas @@ -14,202 +14,185 @@ Process; const - Src: string = 'demos'; - Use: string = 'packages'; - Tst: string = 'testconsole.lpi'; - Pkg: array of string = (); + Target: string = '.'; + Dependencies: array of string = ('Rhl'); 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; + function CheckModules: Output; 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; + '--force', '--remote'], Result.Output) then + Writeln(stderr, #27'[33m', Result.Output, #27'[0m'); end; - procedure AddPackage(Path: string); + function AddPackage(Path: string): 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; + with TRegExpr.Create do + begin + Expression := + {$IFDEF MSWINDOWS} + '(cocoa|x11|_template)' + {$ELSE} + '(cocoa|gdi|_template)' + {$ENDIF} + ; + if not Exec(Path) and RunCommand('lazbuild', ['--add-package-link', Path], + Result.Output) then + Writeln(stderr, #27'[33m', 'added ', Path, #27'[0m'); + Free; end; end; - procedure AddOPM; + function BuildProject(Path: string): Output; + var + Line: string; 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 - Zip := TFileStream.Create(TempFile, fmCreate or fmOpenWrite); - with TFPHttpClient.Create(nil) do + Write(stderr, #27'[33m', 'build from ', Path, #27'[0m'); + 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]; + Writeln(stderr, #27'[32m', ' to ', Result.Output, #27'[0m'); + 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 + begin + WriteLn(stderr); + Writeln(stderr, #27'[31m', Line, #27'[0m'); + end; Free; end; - end; - DeleteFile(TempFile); - AddPackage(PackagePath); end; + except + on E: Exception do + WriteLn(stderr, '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 + ExitCode += 1; + WriteLn(stderr, Result.Output); + except + on E: Exception do + WriteLn(stderr, 'Error: ' + E.ClassName + #13#10 + E.Message); + end; + end; + + function AddOPM(Each: string): string; + var + TempFile, Url: string; + Zip: TStream; + begin + Result := + {$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(Result) then + begin + Zip := TFileStream.Create(TempFile, 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(Url, Zip); + WriteLn(stderr, 'Download from ', Url, ' to ', TempFile); + 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 := TempFile; + OutputPath := Result; + Examine; + UnZipAllFiles; + WriteLn(stderr, 'Unzip from ', TempFile, ' to ', Result); + finally + Free; + end; + end; + DeleteFile(TempFile); end; end; - procedure RunTest; + procedure Main; + var + Each, Item: string; + List: TStringList; begin - List := FindAllFiles('.', Tst, True); + CheckModules; + InitSSLInterface; + for Each in Dependencies do + begin + List := FindAllFiles(AddOPM(Each), '*.lpk', True); + try + for Item in List do + AddPackage(Item); + 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 - 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 + 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; + WriteLn(stderr); + if ExitCode <> 0 then + WriteLn(stderr, #27'[31m', 'Errors: ', ExitCode, #27'[0m') + else + WriteLn(stderr, #27'[32m', 'Errors: ', ExitCode, #27'[0m'); 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 - 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(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'); + Main; end. From c9706a5e5f7994cdf9e34ab13bdfe100d20ae4ea Mon Sep 17 00:00:00 2001 From: "Artem V. Ageev" Date: Wed, 15 Jan 2025 20:43:03 +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 374d520..306c8c0 100644 --- a/.github/workflows/make.pas +++ b/.github/workflows/make.pas @@ -14,7 +14,7 @@ Process; const - Target: string = '.'; + Target: string = 'demos'; Dependencies: array of string = ('Rhl'); type From 93e93fd65c8a21da6c9f26606003d73178fcc79e Mon Sep 17 00:00:00 2001 From: "Artem V. Ageev" Date: Thu, 16 Jan 2025 19:35:48 +0200 Subject: [PATCH 5/7] fix github-actions --- .github/workflows/make.pas | 79 +++++++++++++++++++++----------------- .gitmodules | 13 +------ packages/dopf | 1 - packages/xmailer | 1 - 4 files changed, 46 insertions(+), 48 deletions(-) delete mode 160000 packages/dopf delete mode 160000 packages/xmailer diff --git a/.github/workflows/make.pas b/.github/workflows/make.pas index 306c8c0..42eaa9f 100644 --- a/.github/workflows/make.pas +++ b/.github/workflows/make.pas @@ -15,20 +15,31 @@ const Target: string = 'demos'; - Dependencies: array of string = ('Rhl'); + Dependencies: array of string = ('Rhl', 'XMailer', 'dOPF', 'Brookframework'); type + TLog = (audit, info, error); Output = record Code: boolean; Output: ansistring; end; + + 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'); + end; + end; + function CheckModules: Output; begin if FileExists('.gitmodules') then if RunCommand('git', ['submodule', 'update', '--init', '--recursive', '--force', '--remote'], Result.Output) then - Writeln(stderr, #27'[33m', Result.Output, #27'[0m'); + OutLog(info, Result.Output); end; function AddPackage(Path: string): Output; @@ -37,14 +48,14 @@ Output = record begin Expression := {$IFDEF MSWINDOWS} - '(cocoa|x11|_template)' - {$ELSE} - '(cocoa|gdi|_template)' - {$ENDIF} + '(cocoa|x11|_template)' + {$ELSE} + '(cocoa|gdi|_template)' + {$ENDIF} ; if not Exec(Path) and RunCommand('lazbuild', ['--add-package-link', Path], Result.Output) then - Writeln(stderr, #27'[33m', 'added ', Path, #27'[0m'); + OutLog(audit, 'added ' + Path); Free; end; end; @@ -53,7 +64,7 @@ Output = record var Line: string; begin - Write(stderr, #27'[33m', 'build from ', Path, #27'[0m'); + OutLog(audit, 'build from ' + Path); try Result.Code := RunCommand('lazbuild', ['--build-all', '--recursive', '--no-write-project', Path], Result.Output); @@ -63,7 +74,7 @@ Output = record if ContainsStr(Line, 'Linking') then begin Result.Output := SplitString(Line, ' ')[2]; - Writeln(stderr, #27'[32m', ' to ', Result.Output, #27'[0m'); + OutLog(info, ' to ' + Result.Output); break; end; end @@ -75,16 +86,13 @@ Output = record begin Expression := '(Fatal|Error):'; if Exec(Line) then - begin - WriteLn(stderr); - Writeln(stderr, #27'[31m', Line, #27'[0m'); - end; + OutLog(error, #10 + Line); Free; end; end; except on E: Exception do - WriteLn(stderr, 'Error: ' + E.ClassName + #13#10 + E.Message); + OutLog(error, E.ClassName + #13#10 + E.Message); end; end; @@ -97,17 +105,19 @@ Output = record if Result.Code then try if not RunCommand(Temp, ['--all', '--format=plain', '--progress'], Result.Output) then + begin ExitCode += 1; - WriteLn(stderr, Result.Output); + OutLog(error, Result.Output); + end; except on E: Exception do - WriteLn(stderr, 'Error: ' + E.ClassName + #13#10 + E.Message); + OutLog(error, E.ClassName + #13#10 + E.Message); end; end; - function AddOPM(Each: string): string; + function InstallOPM(Each: string): string; var - TempFile, Url: string; + OutFile, Uri: string; Zip: TStream; begin Result := @@ -117,18 +127,18 @@ Output = record GetEnvironmentVariable('HOME') + '/.lazarus/onlinepackagemanager/packages/' {$ENDIF} + Each; - TempFile := GetTempFileName; - Url := 'https://packages.lazarus-ide.org/' + Each + '.zip'; + OutFile := GetTempFileName; + Uri := 'https://packages.lazarus-ide.org/' + Each + '.zip'; if not DirectoryExists(Result) then begin - Zip := TFileStream.Create(TempFile, fmCreate or fmOpenWrite); + Zip := TFileStream.Create(OutFile, 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); + Get(Uri, Zip); + OutLog(audit, 'Download from ' + Uri + ' to ' + OutFile); finally Free; end; @@ -138,32 +148,32 @@ Output = record with TUnZipper.Create do begin try - FileName := TempFile; + FileName := OutFile; OutputPath := Result; Examine; UnZipAllFiles; - WriteLn(stderr, 'Unzip from ', TempFile, ' to ', Result); + OutLog(audit, 'Unzip from ' + OutFile + ' to ' + Result); finally Free; end; end; - DeleteFile(TempFile); + DeleteFile(OutFile); end; end; - procedure Main; + procedure BuildAll; var Each, Item: string; List: TStringList; begin CheckModules; InitSSLInterface; - for Each in Dependencies do + for Item in Dependencies do begin - List := FindAllFiles(AddOPM(Each), '*.lpk', True); + List := FindAllFiles(InstallOPM(Item), '*.lpk', True); try - for Item in List do - AddPackage(Item); + for Each in List do + AddPackage(Each); finally List.Free; end; @@ -186,13 +196,12 @@ Output = record finally List.Free; end; - WriteLn(stderr); if ExitCode <> 0 then - WriteLn(stderr, #27'[31m', 'Errors: ', ExitCode, #27'[0m') + OutLog(error, #10 + 'Errors: ' + IntToStr(ExitCode)) else - WriteLn(stderr, #27'[32m', 'Errors: ', ExitCode, #27'[0m'); + OutLog(info, #10 + 'Errors: ' + IntToStr(ExitCode)); end; begin - Main; + BuildAll; end. diff --git a/.gitmodules b/.gitmodules index a0ca6d8..4a3c578 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,12 +1,3 @@ [submodule "packages/rutils"] - path = packages/rutils - url = git@github.com:SormJon/rutils.git -[submodule "packages/dopf"] - path = packages/dopf - url = git@github.com:pascal-libs/dopf.git -[submodule "packages/xmailer"] - path = packages/xmailer - url = git@github.com:MFernstrom/xmailer.git -[submodule "packages/brookframework"] - path = packages/brookframework - url = git@github.com:risoflora/brookframework.git + path = packages/rutils + url = git@github.com:SormJon/rutils.git diff --git a/packages/dopf b/packages/dopf deleted file mode 160000 index de1e462..0000000 --- a/packages/dopf +++ /dev/null @@ -1 +0,0 @@ -Subproject commit de1e462e4fb666c34199a95d41ce84ac280ac119 diff --git a/packages/xmailer b/packages/xmailer deleted file mode 160000 index 0290d2f..0000000 --- a/packages/xmailer +++ /dev/null @@ -1 +0,0 @@ -Subproject commit 0290d2f81cd7db8265c125003f2e0552ade79a16 From 6c6b23bda7e0855e946462355a899fcb0e492e6f Mon Sep 17 00:00:00 2001 From: "Artem V. Ageev" Date: Thu, 16 Jan 2025 19:39:24 +0200 Subject: [PATCH 6/7] fix github-actions --- packages/brookframework | 1 - 1 file changed, 1 deletion(-) delete mode 160000 packages/brookframework diff --git a/packages/brookframework b/packages/brookframework deleted file mode 160000 index 9cfd284..0000000 --- a/packages/brookframework +++ /dev/null @@ -1 +0,0 @@ -Subproject commit 9cfd28410e562a51fafde3bdf1fd5fca24c9c2e2 From 6a7dcd858ae2200848f8be2a18f0d7a66b896544 Mon Sep 17 00:00:00 2001 From: "Artem V. Ageev" Date: Thu, 16 Jan 2025 19:44:30 +0200 Subject: [PATCH 7/7] add Synapse40.1 --- .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 42eaa9f..2a6b22f 100644 --- a/.github/workflows/make.pas +++ b/.github/workflows/make.pas @@ -15,7 +15,7 @@ const Target: string = 'demos'; - Dependencies: array of string = ('Rhl', 'XMailer', 'dOPF', 'Brookframework'); + Dependencies: array of string = ('Rhl', 'XMailer', 'dOPF', 'Brookframework', 'Synapse40.1'); type TLog = (audit, info, error);