Skip to content

Commit f38cb85

Browse files
authored
Refactor include files and clean up tests (#7)
* clean up include files * some tests refactorings * update make file * remove unused unit * updates to tests
1 parent c87f112 commit f38cb85

26 files changed

+450
-614
lines changed

.github/workflows/make.pas

Lines changed: 141 additions & 158 deletions
Original file line numberDiff line numberDiff line change
@@ -14,202 +14,185 @@
1414
Process;
1515

1616
const
17-
Src: string = 'SimpleBaseLib.Benchmark/FreePascal.Benchmark';
18-
Use: string = 'SimpleBaseLib/src/Packages/FPC/';
19-
Tst: string = 'SimpleBaseLibConsole.Tests.lpi';
20-
Pkg: array of string = ();
17+
Target: string = '.';
18+
Dependencies: array of string = ();
2119

2220
type
2321
Output = record
24-
Code: integer;
22+
Code: boolean;
2523
Output: ansistring;
2624
end;
2725

28-
var
29-
Each, Item, PackagePath, TempFile, Url: string;
30-
Line: ansistring;
31-
Answer: Output;
32-
List: TStringList;
33-
Zip: TStream;
34-
35-
procedure CheckModules;
26+
function CheckModules: Output;
3627
begin
3728
if FileExists('.gitmodules') then
3829
if RunCommand('git', ['submodule', 'update', '--init', '--recursive',
39-
'--force', '--remote'], Answer.Output) then
40-
Writeln(stderr, #27'[33m', Answer.Output, #27'[0m')
41-
else
42-
begin
43-
ExitCode += 1;
44-
Writeln(stderr, #27'[31m', Answer.Output, #27'[0m');
45-
end;
30+
'--force', '--remote'], Result.Output) then
31+
Writeln(stderr, #27'[33m', Result.Output, #27'[0m');
4632
end;
4733

48-
procedure AddPackage(Path: string);
34+
function AddPackage(Path: string): Output;
4935
begin
50-
List := FindAllFiles(Use, '*.lpk', True);
51-
try
52-
for Each in List do
53-
if RunCommand('lazbuild', ['--add-package-link', Each], Answer.Output) then
54-
Writeln(stderr, #27'[33m', 'added ', Each, #27'[0m')
55-
else
56-
begin
57-
ExitCode += 1;
58-
Writeln(stderr, #27'[31m', 'added ', Each, #27'[0m');
59-
end;
60-
finally
61-
List.Free;
36+
with TRegExpr.Create do
37+
begin
38+
Expression :=
39+
{$IFDEF MSWINDOWS}
40+
'(cocoa|x11|_template)'
41+
{$ELSE}
42+
'(cocoa|gdi|_template)'
43+
{$ENDIF}
44+
;
45+
if not Exec(Path) and RunCommand('lazbuild', ['--add-package-link', Path],
46+
Result.Output) then
47+
Writeln(stderr, #27'[33m', 'added ', Path, #27'[0m');
48+
Free;
6249
end;
6350
end;
6451

65-
procedure AddOPM;
52+
function BuildProject(Path: string): Output;
53+
var
54+
Line: string;
6655
begin
67-
InitSSLInterface;
68-
for Each in Pkg do
69-
begin
70-
PackagePath :=
71-
{$IFDEF MSWINDOWS}
72-
GetEnvironmentVariable('APPDATA') + '\.lazarus\onlinepackagemanager\packages\'
73-
{$ELSE}
74-
GetEnvironmentVariable('HOME') + '/.lazarus/onlinepackagemanager/packages/'
75-
{$ENDIF}
76-
+ Each;
77-
TempFile := GetTempFileName;
78-
Url := 'https://packages.lazarus-ide.org/' + Each + '.zip';
79-
if not DirectoryExists(PackagePath) then
80-
begin
81-
Zip := TFileStream.Create(TempFile, fmCreate or fmOpenWrite);
82-
with TFPHttpClient.Create(nil) do
56+
Write(stderr, #27'[33m', 'build from ', Path, #27'[0m');
57+
try
58+
Result.Code := RunCommand('lazbuild', ['--build-all', '--recursive',
59+
'--no-write-project', Path], Result.Output);
60+
if Result.Code then
61+
for Line in SplitString(Result.Output, LineEnding) do
8362
begin
84-
try
85-
AddHeader('User-Agent', 'Mozilla/5.0 (compatible; fpweb)');
86-
AllowRedirect := True;
87-
Get(Url, Zip);
88-
WriteLn(stderr, 'Download from ', Url, ' to ', TempFile);
89-
finally
90-
Free;
63+
if ContainsStr(Line, 'Linking') then
64+
begin
65+
Result.Output := SplitString(Line, ' ')[2];
66+
Writeln(stderr, #27'[32m', ' to ', Result.Output, #27'[0m');
67+
break;
9168
end;
92-
end;
93-
Zip.Free;
94-
CreateDir(PackagePath);
95-
with TUnZipper.Create do
96-
begin
97-
try
98-
FileName := TempFile;
99-
OutputPath := PackagePath;
100-
Examine;
101-
UnZipAllFiles;
102-
WriteLn(stderr, 'Unzip from ', TempFile, ' to ', PackagePath);
103-
finally
69+
end
70+
else
71+
begin
72+
ExitCode += 1;
73+
for Line in SplitString(Result.Output, LineEnding) do
74+
with TRegExpr.Create do
75+
begin
76+
Expression := '(Fatal|Error):';
77+
if Exec(Line) then
78+
begin
79+
WriteLn(stderr);
80+
Writeln(stderr, #27'[31m', Line, #27'[0m');
81+
end;
10482
Free;
10583
end;
106-
end;
107-
DeleteFile(TempFile);
108-
AddPackage(PackagePath);
10984
end;
85+
except
86+
on E: Exception do
87+
WriteLn(stderr, 'Error: ' + E.ClassName + #13#10 + E.Message);
11088
end;
11189
end;
11290

113-
procedure BuildProject(Path: string);
91+
function RunTest(Path: string): Output;
92+
var
93+
Temp: string;
11494
begin
115-
Write(stderr, #27'[33m', 'build from ', Each, #27'[0m');
116-
try
117-
if RunCommand('lazbuild', ['--build-all', '--recursive',
118-
'--no-write-project', Each], Answer.Output) then
119-
Answer.Code := 0
120-
else
95+
Result := BuildProject(Path);
96+
Temp:= Result.Output;
97+
if Result.Code then
98+
try
99+
if not RunCommand(Temp, ['--all', '--format=plain', '--progress'], Result.Output) then
100+
ExitCode += 1;
101+
WriteLn(stderr, Result.Output);
102+
except
103+
on E: Exception do
104+
WriteLn(stderr, 'Error: ' + E.ClassName + #13#10 + E.Message);
105+
end;
106+
end;
107+
108+
function AddOPM(Each: string): string;
109+
var
110+
TempFile, Url: string;
111+
Zip: TStream;
112+
begin
113+
Result :=
114+
{$IFDEF MSWINDOWS}
115+
GetEnvironmentVariable('APPDATA') + '\.lazarus\onlinepackagemanager\packages\'
116+
{$ELSE}
117+
GetEnvironmentVariable('HOME') + '/.lazarus/onlinepackagemanager/packages/'
118+
{$ENDIF}
119+
+ Each;
120+
TempFile := GetTempFileName;
121+
Url := 'https://packages.lazarus-ide.org/' + Each + '.zip';
122+
if not DirectoryExists(Result) then
123+
begin
124+
Zip := TFileStream.Create(TempFile, fmCreate or fmOpenWrite);
125+
with TFPHttpClient.Create(nil) do
121126
begin
122-
Answer.Code := 1;
123-
ExitCode += Answer.Code;
127+
try
128+
AddHeader('User-Agent', 'Mozilla/5.0 (compatible; fpweb)');
129+
AllowRedirect := True;
130+
Get(Url, Zip);
131+
WriteLn(stderr, 'Download from ', Url, ' to ', TempFile);
132+
finally
133+
Free;
134+
end;
124135
end;
125-
except
126-
on E: Exception do
127-
WriteLn(stderr, 'Error: ' + E.ClassName + #13#10 + E.Message);
136+
Zip.Free;
137+
CreateDir(Result);
138+
with TUnZipper.Create do
139+
begin
140+
try
141+
FileName := TempFile;
142+
OutputPath := Result;
143+
Examine;
144+
UnZipAllFiles;
145+
WriteLn(stderr, 'Unzip from ', TempFile, ' to ', Result);
146+
finally
147+
Free;
148+
end;
149+
end;
150+
DeleteFile(TempFile);
128151
end;
129152
end;
130153

131-
procedure RunTest;
154+
function Main: Output;
155+
var
156+
Each, Item: string;
157+
List: TStringList;
132158
begin
133-
List := FindAllFiles('.', Tst, True);
159+
CheckModules;
160+
InitSSLInterface;
161+
for Each in Dependencies do
162+
begin
163+
List := FindAllFiles(AddOPM(Each), '*.lpk', True);
164+
try
165+
for Item in List do
166+
AddPackage(Item);
167+
finally
168+
List.Free;
169+
end;
170+
end;
171+
List := FindAllFiles(GetCurrentDir, '*.lpk', True);
134172
try
135173
for Each in List do
136-
begin
137-
BuildProject(Each);
138-
if Answer.Code <> 0 then
139-
begin
140-
for Line in SplitString(Answer.Output, LineEnding) do
141-
with TRegExpr.Create do
142-
begin
143-
Expression := '(Fatal|Error):';
144-
if Exec(Line) then
145-
begin
146-
WriteLn(stderr);
147-
Writeln(stderr, #27'[31m', Line, #27'[0m');
148-
end;
149-
Free;
150-
end;
151-
end
174+
AddPackage(Each);
175+
finally
176+
List.Free;
177+
end;
178+
List := FindAllFiles(Target, '*.lpi', True);
179+
try
180+
for Each in List do
181+
if ContainsStr(ReadFileToString(ReplaceStr(Each, '.lpi', '.lpr')),
182+
'consoletestrunner') then
183+
RunTest(Each)
152184
else
153-
for Line in SplitString(Answer.Output, LineEnding) do
154-
if Pos('Linking', Line) <> 0 then
155-
try
156-
begin
157-
Writeln(stderr, #27'[32m', ' to ', SplitString(Line, ' ')[2], #27'[0m');
158-
if not RunCommand(ReplaceStr(SplitString(Line, ' ')[2],
159-
SplitString(Tst, '.')[0], './' + SplitString(Tst, '.')[0]),
160-
['--all', '--format=plain', '--progress'], Answer.Output) then
161-
ExitCode += 1;
162-
WriteLn(stderr, Answer.Output);
163-
break;
164-
end;
165-
except
166-
on E: Exception do
167-
WriteLn(stderr, 'Error: ' + E.ClassName + #13#10 + E.Message);
168-
end;
169-
end;
185+
BuildProject(Each);
170186
finally
171187
List.Free;
172188
end;
189+
WriteLn(stderr);
190+
if ExitCode <> 0 then
191+
WriteLn(stderr, #27'[31m', 'Errors: ', ExitCode, #27'[0m')
192+
else
193+
WriteLn(stderr, #27'[32m', 'Errors: ', ExitCode, #27'[0m');
173194
end;
174195

175196
begin
176-
CheckModules;
177-
AddPackage(Use);
178-
AddOPM;
179-
{$IFDEF LINUX}
180-
RunTest;
181-
{$ENDIF}
182-
List := FindAllFiles(Src, '*.lpi', True);
183-
try
184-
for Each in List do
185-
if Pos(Tst, Each) = 0 then
186-
begin
187-
BuildProject(Each);
188-
if Answer.Code <> 0 then
189-
begin
190-
for Line in SplitString(Answer.Output, LineEnding) do
191-
with TRegExpr.Create do
192-
begin
193-
Expression := '(Fatal|Error):';
194-
if Exec(Line) then
195-
begin
196-
WriteLn(stderr);
197-
Writeln(stderr, #27'[31m', Line, #27'[0m');
198-
end;
199-
Free;
200-
end;
201-
end
202-
else
203-
for Line in SplitString(Answer.Output, LineEnding) do
204-
if Pos('Linking', Line) <> 0 then
205-
Writeln(stderr, #27'[32m', ' to ', SplitString(Line, ' ')[2], #27'[0m');
206-
end;
207-
finally
208-
List.Free;
209-
end;
210-
WriteLn(stderr);
211-
if ExitCode <> 0 then
212-
WriteLn(stderr, #27'[31m', 'Errors: ', ExitCode, #27'[0m')
213-
else
214-
WriteLn(stderr, #27'[32m', 'Errors: ', ExitCode, #27'[0m');
197+
Main;
215198
end.

0 commit comments

Comments
 (0)