administrator/blaise
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

Modernise stdlib testing + tools: TList<String> over TStringList, drop .Free

Browse source 
Showcase generics + ARC across the test framework and tools. Replace
TStringList with TList<String> wherever only the basic list API was used
(Create/Add/Get/Count/Clear/Delete/IndexOf), rewriting .Strings[i] to .Get(i),
and remove manual .Free calls since Blaise reference-counts objects.

Lists genuinely needing TStringList-only API stay as TStringList: file I/O
(LoadFromFile/SaveToFile/Text), object association (AddObject/Objects[] in the
test registry and bif-coverage AST), and dup control (Duplicates). Destructors
that only freed fields are deleted.

stdlib 47 tests, compiler 3743 tests (20 pre-existing toolchain failures
unchanged), varcheck 18 regression tests all pass.
This commit is contained in:
Graeme Geldenhuys 2026-06-23 19:21:09 +01:00
parent 93d7bda739
commit 676cee0cae
6 changed files with 239 additions and 327 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

58
compiler/src/test/pascal/cp.test.runner_filters.pas
View file

@ -16,7 +16,7 @@ unit cp.test.runner_filters;
interface
uses
blaise.testing, Classes,
blaise.testing, Generics.Collections,
blaise.testing.runner.text;
type
@ -66,49 +66,49 @@ begin
end;
procedure TRunnerFiltersTests.TestAppend_Single;
var L: TStringList;
var L: TList<String>;
begin
L := TStringList.Create();
L := TList<String>.Create();
AppendSuiteFilter(L, 'TFoo');
AssertEquals('count', 1, L.Count);
AssertEquals('value', 'TFoo', L.Strings[0]);
AssertEquals('value', 'TFoo', L.Get(0));
end;
procedure TRunnerFiltersTests.TestAppend_CommaSeparated;
var L: TStringList;
var L: TList<String>;
begin
L := TStringList.Create();
L := TList<String>.Create();
AppendSuiteFilter(L, 'TA,TB.m,TC');
AssertEquals('count', 3, L.Count);
AssertEquals('first', 'TA', L.Strings[0]);
AssertEquals('second', 'TB.m', L.Strings[1]);
AssertEquals('third', 'TC', L.Strings[2]);
AssertEquals('first', 'TA', L.Get(0));
AssertEquals('second', 'TB.m', L.Get(1));
AssertEquals('third', 'TC', L.Get(2));
end;
procedure TRunnerFiltersTests.TestAppend_TrimsSpaces;
var L: TStringList;
var L: TList<String>;
begin
L := TStringList.Create();
L := TList<String>.Create();
AppendSuiteFilter(L, ' TA , TB.m ');
AssertEquals('count', 2, L.Count);
AssertEquals('first', 'TA', L.Strings[0]);
AssertEquals('second', 'TB.m', L.Strings[1]);
AssertEquals('first', 'TA', L.Get(0));
AssertEquals('second', 'TB.m', L.Get(1));
end;
procedure TRunnerFiltersTests.TestAppend_SkipsEmptyEntries;
var L: TStringList;
var L: TList<String>;
begin
L := TStringList.Create();
L := TList<String>.Create();
AppendSuiteFilter(L, ',TA,,TB,');
AssertEquals('count', 2, L.Count);
AssertEquals('first', 'TA', L.Strings[0]);
AssertEquals('second', 'TB', L.Strings[1]);
AssertEquals('first', 'TA', L.Get(0));
AssertEquals('second', 'TB', L.Get(1));
end;
procedure TRunnerFiltersTests.TestMatches_EmptyFiltersAcceptAll;
var L: TStringList;
var L: TList<String>;
begin
L := TStringList.Create();
L := TList<String>.Create();
AssertTrue('empty list matches arbitrary test',
MatchesFilters(L, 'TFoo', 'TestBar'));
AssertTrue('nil filter list matches arbitrary test',
@ -116,43 +116,43 @@ begin
end;
procedure TRunnerFiltersTests.TestMatches_ClassFilterMatchesAnyMethod;
var L: TStringList;
var L: TList<String>;
begin
L := TStringList.Create();
L := TList<String>.Create();
L.Add('TFoo');
AssertTrue('first method', MatchesFilters(L, 'TFoo', 'TestA'));
AssertTrue('second method', MatchesFilters(L, 'TFoo', 'TestB'));
end;
procedure TRunnerFiltersTests.TestMatches_ClassFilterRejectsOtherClass;
var L: TStringList;
var L: TList<String>;
begin
L := TStringList.Create();
L := TList<String>.Create();
L.Add('TFoo');
AssertFalse('other class', MatchesFilters(L, 'TBar', 'TestA'));
end;
procedure TRunnerFiltersTests.TestMatches_MethodFilterIsExact;
var L: TStringList;
var L: TList<String>;
begin
L := TStringList.Create();
L := TList<String>.Create();
L.Add('TFoo.TestBar');
AssertTrue('exact match', MatchesFilters(L, 'TFoo', 'TestBar'));
end;
procedure TRunnerFiltersTests.TestMatches_MethodFilterRejectsOtherMethod;
var L: TStringList;
var L: TList<String>;
begin
L := TStringList.Create();
L := TList<String>.Create();
L.Add('TFoo.TestBar');
AssertFalse('different method same class',
MatchesFilters(L, 'TFoo', 'TestQux'));
end;
procedure TRunnerFiltersTests.TestMatches_MultipleFiltersAreUnion;
var L: TStringList;
var L: TList<String>;
begin
L := TStringList.Create();
L := TList<String>.Create();
L.Add('TFoo.TestA');
L.Add('TBar');
AssertTrue('first filter hits',

26
stdlib/src/main/pascal/blaise.testing.pas
View file

@ -34,7 +34,7 @@ unit blaise.testing;
interface
uses
Classes, SysUtils;
Classes, Generics.Collections, SysUtils;
type
{ TRunMethod — type of a parameter-less method on any TObject descendant.
@ -51,14 +51,13 @@ type
FNumberOfFailures: Integer;
FNumberOfErrors: Integer;
FNumberOfIgnored: Integer;
FFailureList: TStringList;
FErrorList: TStringList;
FFailureList: TList<String>;
FErrorList: TList<String>;
FVerbose: Boolean;
FCurrentClassName: string;
FCurrentTestName: string;
public
constructor Create;
destructor Destroy; override;
procedure StartTest (AClassName, ATestName: string);
procedure EndTest (AOutcome: string);
@ -73,8 +72,8 @@ type
property NumberOfFailures: Integer read FNumberOfFailures;
property NumberOfErrors: Integer read FNumberOfErrors;
property NumberOfIgnored: Integer read FNumberOfIgnored;
property Failures: TStringList read FFailureList;
property Errors: TStringList read FErrorList;
property Failures: TList<String> read FFailureList;
property Errors: TList<String> read FErrorList;
property Verbose: Boolean read FVerbose write FVerbose;
end;
@ -562,20 +561,13 @@ begin
Self.FNumberOfFailures := 0;
Self.FNumberOfErrors := 0;
Self.FNumberOfIgnored := 0;
Self.FFailureList := TStringList.Create();
Self.FErrorList := TStringList.Create();
Self.FFailureList := TList<String>.Create();
Self.FErrorList := TList<String>.Create();
Self.FVerbose := False;
Self.FCurrentClassName := '';
Self.FCurrentTestName := '';
end;
destructor TTestResult.Destroy;
begin
Self.FFailureList.Free();
Self.FErrorList.Free();
inherited Destroy();
end;
procedure TTestResult.StartTest(AClassName, ATestName: string);
begin
Self.FNumberOfTests := Self.FNumberOfTests + 1;
@ -616,9 +608,9 @@ begin
Self.FNumberOfErrors := Self.FNumberOfErrors + ASource.FNumberOfErrors;
Self.FNumberOfIgnored := Self.FNumberOfIgnored + ASource.FNumberOfIgnored;
for I := 0 to ASource.FFailureList.Count - 1 do
Self.FFailureList.Add(ASource.FFailureList.Strings[I]);
Self.FFailureList.Add(ASource.FFailureList.Get(I));
for I := 0 to ASource.FErrorList.Count - 1 do
Self.FErrorList.Add(ASource.FErrorList.Strings[I]);
Self.FErrorList.Add(ASource.FErrorList.Get(I));
end;
function TTestResult.Summary: string;

102
stdlib/src/main/pascal/blaise.testing.runner.text.pas
View file

@ -37,7 +37,7 @@ unit blaise.testing.runner.text;
interface
uses
blaise.testing, Classes, SysUtils, Process;
blaise.testing, Classes, Generics.Collections, SysUtils, Process;
{ Run every test method of every TTestCase class registered via
RegisterTest. Returns the result so the caller can compute an
@ -54,7 +54,7 @@ procedure PrintSummary(AResult: TTestResult);
function RunAll: Integer;
{ Filter helpers — exposed for unit testing. A filter list is a
TStringList where every entry is either a class-only filter ("TFooTests")
TList<String> where every entry is either a class-only filter ("TFooTests")
or a class.method filter ("TFooTests.TestBar"). }
{ Split a single user-supplied filter spec into class and method parts.
@ -64,11 +64,11 @@ procedure SplitSuiteSpec(const ASpec: string;
{ Append ASpec to AFilters. If ASpec contains commas, each
comma-delimited entry is appended individually after trimming. }
procedure AppendSuiteFilter(AFilters: TStringList; const ASpec: string);
procedure AppendSuiteFilter(AFilters: TList<String>; const ASpec: string);
{ True if the (ASuite, AMethod) pair matches at least one filter in
AFilters. An empty filter list always matches. }
function MatchesFilters(AFilters: TStringList;
function MatchesFilters(AFilters: TList<String>;
const ASuite, AMethod: string): Boolean;
@ -206,7 +206,7 @@ begin
Result := Copy(S, Lo, Hi - Lo + 1);
end;
procedure AppendSuiteFilter(AFilters: TStringList; const ASpec: string);
procedure AppendSuiteFilter(AFilters: TList<String>; const ASpec: string);
var
Start, I: Integer;
Part: string;
@ -228,7 +228,7 @@ begin
AFilters.Add(Part);
end;
function MatchesFilters(AFilters: TStringList;
function MatchesFilters(AFilters: TList<String>;
const ASuite, AMethod: string): Boolean;
var
I: Integer;
@ -241,7 +241,7 @@ begin
end;
for I := 0 to AFilters.Count - 1 do
begin
SplitSuiteSpec(AFilters.Strings[I], FSuite, FMethod);
SplitSuiteSpec(AFilters.Get(I), FSuite, FMethod);
if FSuite <> ASuite then
Continue;
if (FMethod = '') or (FMethod = AMethod) then
@ -255,7 +255,7 @@ end;
{ True if any filter in AFilters names ASuite (regardless of whether
the filter pins a specific method). Used to decide whether a class
should be considered for execution at all. }
function FiltersTouchSuite(AFilters: TStringList;
function FiltersTouchSuite(AFilters: TList<String>;
const ASuite: string): Boolean;
var
I: Integer;
@ -268,7 +268,7 @@ begin
end;
for I := 0 to AFilters.Count - 1 do
begin
SplitSuiteSpec(AFilters.Strings[I], FSuite, FMethod);
SplitSuiteSpec(AFilters.Get(I), FSuite, FMethod);
if FSuite = ASuite then
begin
Exit(True);
@ -282,7 +282,7 @@ end;
times and each --suite value may be comma-delimited. Empty list
means "run everything". AVerbose is True when --verbose is present.
AFilters must be created by the caller and is owned by the caller. }
procedure ParseArgs(AFilters: TStringList; out AVerbose: Boolean);
procedure ParseArgs(AFilters: TList<String>; out AVerbose: Boolean);
var
I: Integer;
Arg: string;
@ -326,48 +326,44 @@ var
MsgBody: string;
begin
Lines := TStringList.Create();
try
Lines.Text := AOutput;
InFail := False;
InErr := False;
for I := 0 to Lines.Count - 1 do
Lines.Text := AOutput;
InFail := False;
InErr := False;
for I := 0 to Lines.Count - 1 do
begin
Line := Lines.Strings[I];
if Line = 'Failures:' then begin InFail := True; InErr := False; Continue end;
if Line = 'Errors:' then begin InErr := True; InFail := False; Continue end;
if InFail or InErr then
begin
Line := Lines.Strings[I];
if Line = 'Failures:' then begin InFail := True; InErr := False; Continue end;
if Line = 'Errors:' then begin InErr := True; InFail := False; Continue end;
if InFail or InErr then
{ Indented detail lines: " MethodName: message" }
if (Length(Line) > 2) and (Copy(Line, 0, 2) = ' ') then
begin
{ Indented detail lines: " MethodName: message" }
if (Length(Line) > 2) and (Copy(Line, 0, 2) = ' ') then
P := Pos(': ', Line);
if P >= 0 then
begin
P := Pos(': ', Line);
if P >= 0 then
begin
MsgName := Copy(Line, 2, P - 2);
MsgBody := Copy(Line, P + 2, Length(Line));
if InFail then
AResult.AddFailure(MsgName, MsgBody)
else
AResult.AddError(MsgName, MsgBody);
end;
Continue;
MsgName := Copy(Line, 2, P - 2);
MsgBody := Copy(Line, P + 2, Length(Line));
if InFail then
AResult.AddFailure(MsgName, MsgBody)
else
AResult.AddError(MsgName, MsgBody);
end;
InFail := False; InErr := False;
end;
{ Verbose outcome line: "CName.MName ... OUTCOME" }
if Pos(' ... ', Line) >= 0 then
begin
AResult.StartTest('', '');
if (Pos(' ... FAIL', Line) >= 0) or (Pos(' ... ERROR', Line) >= 0) then
AResult.EndTest('FAIL')
else if Pos(' ... IGNORED', Line) >= 0 then
AResult.EndTest('IGNORED')
else
AResult.EndTest('OK');
Continue;
end;
InFail := False; InErr := False;
end;
{ Verbose outcome line: "CName.MName ... OUTCOME" }
if Pos(' ... ', Line) >= 0 then
begin
AResult.StartTest('', '');
if (Pos(' ... FAIL', Line) >= 0) or (Pos(' ... ERROR', Line) >= 0) then
AResult.EndTest('FAIL')
else if Pos(' ... IGNORED', Line) >= 0 then
AResult.EndTest('IGNORED')
else
AResult.EndTest('OK');
end;
finally
Lines.Free();
end;
end;
@ -382,7 +378,7 @@ end;
parallel while non-threaded suites run in-process. After in-process
tests finish, remaining subprocess output is collected.
When --suite is given, the named suite runs directly (no subprocess). }
function RunFilteredTests(AFilters: TStringList; AVerbose: Boolean): TTestResult;
function RunFilteredTests(AFilters: TList<String>; AVerbose: Boolean): TTestResult;
var
ClsIdx: Integer;
Cls: TTestCaseClass;
@ -489,8 +485,8 @@ end;
procedure PrintSummary(AResult: TTestResult);
var
I: Integer;
Fails: TStringList;
Errs: TStringList;
Fails: TList<String>;
Errs: TList<String>;
Line: string;
begin
WriteLn(AResult.Summary());
@ -502,7 +498,7 @@ begin
I := 0;
while I < AResult.NumberOfFailures do
begin
Line := Fails.Strings[I];
Line := Fails.Get(I);
WriteLn(' ' + Line);
I := I + 1
end;
@ -515,7 +511,7 @@ begin
I := 0;
while I < AResult.NumberOfErrors do
begin
Line := Errs.Strings[I];
Line := Errs.Get(I);
WriteLn(' ' + Line);
I := I + 1
end;
@ -525,10 +521,10 @@ end;
function RunAll: Integer;
var
R: TTestResult;
Filters: TStringList;
Filters: TList<String>;
Verbose: Boolean;
begin
Filters := TStringList.Create();
Filters := TList<String>.Create();
ParseArgs(Filters, Verbose);
R := RunFilteredTests(Filters, Verbose);
PrintSummary(R);

144
tools/bif-coverage/src/main/pascal/BifCoverage.pas
View file

@ -38,7 +38,7 @@
program BifCoverage;
uses
SysUtils, Classes, Contnrs, strutils, uStrCompat;
SysUtils, Classes, Contnrs, Generics.Collections, strutils, uStrCompat;
const
AST_REL = 'compiler/src/main/pascal/uAST.pas';
@ -106,7 +106,6 @@ type
SrcName: string; { basename of the source file the class came from,
for [new]/header location reporting }
constructor Create;
destructor Destroy; override;
end;
TIOBlock = class
@ -139,12 +138,6 @@ begin
Fields := TStringList.Create;
end;
destructor TASTClass.Destroy;
begin
Fields.Free;
inherited Destroy;
end;
constructor TIOBlock.Create;
begin
inherited Create;
@ -348,12 +341,12 @@ end;
supported). The caller is responsible for only invoking this inside
the public section. Returns the comma-separated list of field names,
or empty if the line is not a field declaration. *)
function ParseFieldNames(const ALine: string): TStringList;
function ParseFieldNames(const ALine: string): TList<String>;
var
Stripped, Tok: string;
P, Len: Integer;
begin
Result := TStringList.Create;
Result := TList<String>.Create;
Stripped := StripAttrs(ALine);
P := 0;
Len := Length(Stripped);
@ -411,7 +404,7 @@ end;
(* True when AAllow is nil (accept every class) or AName appears in
the allow-list. Lets the same scan run over uAST.pas (all classes)
and uUnitInterface.pas (only the target .bif container types). *)
function ClassAccepted(AAllow: TStringList; const AName: string): Boolean;
function ClassAccepted(AAllow: TList<String>; const AName: string): Boolean;
begin
Result := (AAllow = nil) or (AAllow.IndexOf(AName) >= 0);
end;
@ -423,18 +416,18 @@ end;
are shared with the AST scan. When AAllow is non-nil only classes
named in it are recorded. *)
procedure ScanClassFile(const APath: string;
ANames: TStringList; AObjs: TObjectList; AAllow: TStringList);
ANames: TStringList; AObjs: TObjectList; AAllow: TList<String>);
var
Lines: TStringList;
InBlockComment, InPublic, InClassBody, HasBody, IsEnd, Recording: Boolean;
I, J: Integer;
Raw, Stripped, Trimmed, Name, Parent, SrcName: string;
Cls: TASTClass;
FieldNames: TStringList;
FieldNames: TList<String>;
begin
SrcName := ExtractFileName(APath);
Lines := LoadLines(APath);
try
begin
InBlockComment := False;
InClassBody := False;
InPublic := True;
@ -491,16 +484,10 @@ begin
a real field — skip it. Plain public fields never contain (). }
if (Pos('(', Trimmed) >= 0) or (Pos(')', Trimmed) >= 0) then Continue;
FieldNames := ParseFieldNames(Trimmed);
try
for J := 0 to FieldNames.Count - 1 do
Cls.Fields.AddObject(FieldNames.Strings[J],
Pointer(PtrUInt(I + 1)));
finally
FieldNames.Free;
end;
for J := 0 to FieldNames.Count - 1 do
Cls.Fields.AddObject(FieldNames[J],
Pointer(PtrUInt(I + 1)));
end;
finally
Lines.Free;
end;
end;
@ -516,21 +503,17 @@ end;
and are checked against the file-level IO haystacks. *)
procedure ScanInterfaceTypes();
var
Allow: TStringList;
Allow: TList<String>;
I: Integer;
begin
Allow := TStringList.Create;
try
for I := 0 to IFACE_TYPE_COUNT - 1 do
Allow.Add(GIfaceTypes[I]);
ScanClassFile(GIfaceFile, GIfaceNames, GIfaceObjs, Allow);
Allow := TList<String>.Create;
for I := 0 to IFACE_TYPE_COUNT - 1 do
Allow.Add(GIfaceTypes[I]);
ScanClassFile(GIfaceFile, GIfaceNames, GIfaceObjs, Allow);
Allow.Clear;
Allow.Add('TMethodParam');
ScanClassFile(GAstFile, GIfaceNames, GIfaceObjs, Allow);
finally
Allow.Free;
end;
Allow.Clear;
Allow.Add('TMethodParam');
ScanClassFile(GAstFile, GIfaceNames, GIfaceObjs, Allow);
end;
function IfaceAt(I: Integer): TASTClass;
@ -551,7 +534,7 @@ end;
lines and return it as one concatenated string. The body spans from
the first `begin` after the signature to the matching `end;` (depth
counting on begin/case/record/try). *)
function ExtractFunctionBody(ALines: TStringList; const AFName: string): string;
function ExtractFunctionBody(ALines: TList<String>; const AFName: string): string;
var
I, J, P, Depth: Integer;
Line, Tok: string;
@ -565,7 +548,7 @@ begin
Depth := 0;
for I := 0 to ALines.Count - 1 do
begin
Line := ALines.Strings[I];
Line := ALines[I];
if not InFn then
begin
if (Pos(Header, Line) >= 0) and (Pos('forward', Line) < 0) then
@ -617,16 +600,16 @@ end;
procedure CarveEncodeBlocks(const ABody: string;
ANames: TStringList; AObjs: TObjectList);
var
MarkPositions: TStringList;
MarkNames: TStringList;
MarkPositions: TList<String>;
MarkNames: TList<String>;
P, Len, Save: Integer;
Tok: string;
Blk: TIOBlock;
I, EndPos, StartPos: Integer;
begin
MarkPositions := TStringList.Create;
MarkNames := TStringList.Create;
try
MarkPositions := TList<String>.Create;
MarkNames := TList<String>.Create;
begin
Len := Length(ABody);
P := 0;
while P < Len do
@ -650,20 +633,17 @@ begin
end;
for I := 0 to MarkNames.Count - 1 do
begin
StartPos := StrToInt(MarkPositions.Strings[I]);
StartPos := StrToInt(MarkPositions[I]);
if I < MarkNames.Count - 1 then
EndPos := StrToInt(MarkPositions.Strings[I + 1])
EndPos := StrToInt(MarkPositions[I + 1])
else
EndPos := Len;
Blk := TIOBlock.Create;
Blk.ClsName := MarkNames.Strings[I];
Blk.ClsName := MarkNames[I];
Blk.Body := Copy(ABody, StartPos, EndPos - StartPos);
ANames.Add(MarkNames.Strings[I]);
ANames.Add(MarkNames[I]);
AObjs.Add(Blk);
end;
finally
MarkPositions.Free;
MarkNames.Free;
end;
end;
@ -673,13 +653,13 @@ end;
procedure CarveDecodeBlocks(const ABody: string;
ANames: TStringList; AObjs: TObjectList);
var
Starts: TStringList;
Starts: TList<String>;
P, Len, I, EndPos, J, Q, StartPos: Integer;
Block, Tok: string;
Blk: TIOBlock;
begin
Starts := TStringList.Create;
try
Starts := TList<String>.Create;
begin
Len := Length(ABody);
P := 0;
while P + 7 < Len do
@ -694,8 +674,8 @@ begin
end;
for I := 0 to Starts.Count - 1 do
begin
StartPos := StrToInt(Starts.Strings[I]);
if I < Starts.Count - 1 then EndPos := StrToInt(Starts.Strings[I + 1])
StartPos := StrToInt(Starts[I]);
if I < Starts.Count - 1 then EndPos := StrToInt(Starts[I + 1])
else EndPos := Len;
Block := Copy(ABody, StartPos, EndPos - StartPos);
J := 0;
@ -721,8 +701,6 @@ begin
Inc(J);
end;
end;
finally
Starts.Free;
end;
end;
@ -751,17 +729,18 @@ end;
procedure ScanIO();
var
Raw, Cleaned: TStringList;
Raw: TStringList;
Cleaned: TList<String>;
I: Integer;
InBlockComment, InImpl, InDecoder: Boolean;
Body, Line, Trimmed: string;
EncSB, DecSB: TStringBuilder;
begin
Raw := LoadLines(GIoFile);
Cleaned := TStringList.Create;
Cleaned := TList<String>.Create;
EncSB := TStringBuilder.Create;
DecSB := TStringBuilder.Create;
try
begin
InBlockComment := False;
InImpl := False;
InDecoder := False;
@ -790,11 +769,6 @@ begin
CarveDecodeBlocks(Body, GDecodeNames, GDecodeObjs);
GIoEncodeText := EncSB.ToString();
GIoDecodeText := DecSB.ToString();
finally
DecSB.Free;
EncSB.Free;
Cleaned.Free;
Raw.Free;
end;
end;
@ -823,7 +797,7 @@ begin
Result := '';
if not FileExists(GRootProject) then Exit;
Lines := TStringList.Create;
try
begin
Lines.LoadFromFile(GRootProject);
for I := 0 to Lines.Count - 1 do
begin
@ -837,8 +811,6 @@ begin
Result := Trim(Result);
Exit;
end;
finally
Lines.Free;
end;
end;
@ -853,7 +825,7 @@ begin
Result := '';
if not FileExists(GCompilerIdFile) then Exit;
Lines := TStringList.Create;
try
begin
Lines.LoadFromFile(GCompilerIdFile);
for I := 0 to Lines.Count - 1 do
begin
@ -867,8 +839,6 @@ begin
Result := Copy(Line, Q1 + 1, Q2);
Exit;
end;
finally
Lines.Free;
end;
end;
@ -899,7 +869,7 @@ begin
if not FileExists(GIoFile) then Exit;
Needle := '.' + AFieldName;
Lines := TStringList.Create;
try
begin
Lines.LoadFromFile(GIoFile);
for I := AStartLine to Lines.Count - 1 do
begin
@ -909,8 +879,6 @@ begin
Result := I + 1;
Exit;
end;
finally
Lines.Free;
end;
end;
@ -934,7 +902,7 @@ begin
Result := 0;
if not FileExists(GIoFile) then Exit;
Lines := TStringList.Create;
try
begin
Lines.LoadFromFile(GIoFile);
for I := 0 to Lines.Count - 1 do
begin
@ -947,8 +915,6 @@ begin
Exit;
end;
end;
finally
Lines.Free;
end;
end;
@ -1011,7 +977,7 @@ var
FieldName, State, Header: string;
begin
Outp := TStringList.Create;
try
begin
Outp.Add('# bif-coverage status - one line per public AST field.');
Outp.Add('# Format: <TClass>.<Field> <serialise|safe>');
Outp.Add('# serialise must appear in EncodeStmt/EncodeExpr AND ReadStmt/ReadExpr');
@ -1064,8 +1030,6 @@ begin
Outp.SaveToFile(GStatusFile);
WriteLn('bif-coverage: wrote ' + GStatusFile);
finally
Outp.Free;
end;
end;
@ -1082,7 +1046,7 @@ var
Line, Key, State, ClsName, FieldName, Loc: string;
Cls: TASTClass;
Blk: TIOBlock;
KnownFields: TStringList;
KnownFields: TList<String>;
EncoderHasField, DecoderHasField, IsIface: Boolean;
begin
if not FileExists(GStatusFile) then
@ -1091,8 +1055,8 @@ begin
Exit;
end;
Status := TStringList.Create;
KnownFields := TStringList.Create;
try
KnownFields := TList<String>.Create;
begin
Status.LoadFromFile(GStatusFile);
for I := 0 to Status.Count - 1 do
begin
@ -1223,24 +1187,9 @@ begin
Key + Loc);
end;
end;
finally
Status.Free;
KnownFields.Free;
end;
end;
procedure FreeAll();
begin
GASTObjs.Free; { owns: frees TASTClass instances }
GEncodeObjs.Free; { owns: frees TIOBlock instances }
GDecodeObjs.Free;
GIfaceObjs.Free; { owns: frees TASTClass instances }
GASTNames.Free;
GEncodeNames.Free;
GDecodeNames.Free;
GIfaceNames.Free;
end;
begin
GErrors := 0;
GDecoderStart := -1;
@ -1305,6 +1254,5 @@ begin
WriteLn('bif-coverage: OK')
else
WriteLn('bif-coverage: ' + IntToStr(GErrors) + ' gap(s) found');
FreeAll();
if GErrors > 0 then Halt(1);
end.

200
tools/kanban/src/main/pascal/kanban.data.pas
View file

@ -44,7 +44,6 @@ type
function IsDeleted(AId: Integer): Boolean;
public
constructor Create(const AFilePath: string);
destructor Destroy; override;
procedure Load;
procedure Save;
function AddTask(const ATitle: string; AStatus: TTaskStatus): TTask;
@ -77,13 +76,6 @@ begin
FLastMtime := -1
end;
destructor TBoard.Destroy;
begin
FDeletedIds.Free();
FTasks.Free();
inherited Destroy
end;
function TBoard.GetCount: Integer;
begin
Result := FTasks.Count
@ -197,30 +189,26 @@ begin
if not FileExists(FFilePath) then Exit;
Lines := TStringList.Create();
try
Lines.LoadFromFile(FFilePath);
CurrentStatus := tsTodo;
I := 0;
while I < Lines.Count do
Lines.LoadFromFile(FFilePath);
CurrentStatus := tsTodo;
I := 0;
while I < Lines.Count do
begin
Line := Lines.Get(I);
if StartsStr('## Todo', Line) then
CurrentStatus := tsTodo
else if StartsStr('## In Progress', Line) then
CurrentStatus := tsInProgress
else if StartsStr('## Done', Line) then
CurrentStatus := tsDone
else if StartsStr('#next-id:', Line) then
begin
Line := Lines.Get(I);
if StartsStr('## Todo', Line) then
CurrentStatus := tsTodo
else if StartsStr('## In Progress', Line) then
CurrentStatus := tsInProgress
else if StartsStr('## Done', Line) then
CurrentStatus := tsDone
else if StartsStr('#next-id:', Line) then
begin
IdLine := Trim(Copy(Line, 9, Length(Line) - 9));
FNextId := StrToInt(IdLine)
end
else if StartsStr('- ', Line) then
Self.ParseLine(Line, CurrentStatus);
I := I + 1
IdLine := Trim(Copy(Line, 9, Length(Line) - 9));
FNextId := StrToInt(IdLine)
end
finally
Lines.Free()
else if StartsStr('- ', Line) then
Self.ParseLine(Line, CurrentStatus);
I := I + 1
end;
FLastMtime := FileAge(FFilePath)
end;
@ -234,45 +222,41 @@ begin
if Self.HasExternalChanges() then
Self.MergeFromDisk();
Lines := TStringList.Create();
try
Lines.Add('#next-id: ' + IntToStr(FNextId));
Lines.Add('');
Lines.Add('## Todo');
I := 0;
while I < FTasks.Count do
begin
Task := TTask(FTasks.Get(I));
if Task.FStatus = tsTodo then
Lines.Add(Self.FormatTask(Task));
I := I + 1
end;
Lines.Add('');
Lines.Add('## In Progress');
I := 0;
while I < FTasks.Count do
begin
Task := TTask(FTasks.Get(I));
if Task.FStatus = tsInProgress then
Lines.Add(Self.FormatTask(Task));
I := I + 1
end;
Lines.Add('');
Lines.Add('## Done');
I := 0;
while I < FTasks.Count do
begin
Task := TTask(FTasks.Get(I));
if Task.FStatus = tsDone then
Lines.Add(Self.FormatTask(Task));
I := I + 1
end;
Lines.SaveToFile(FFilePath)
finally
Lines.Free()
Lines.Add('#next-id: ' + IntToStr(FNextId));
Lines.Add('');
Lines.Add('## Todo');
I := 0;
while I < FTasks.Count do
begin
Task := TTask(FTasks.Get(I));
if Task.FStatus = tsTodo then
Lines.Add(Self.FormatTask(Task));
I := I + 1
end;
Lines.Add('');
Lines.Add('## In Progress');
I := 0;
while I < FTasks.Count do
begin
Task := TTask(FTasks.Get(I));
if Task.FStatus = tsInProgress then
Lines.Add(Self.FormatTask(Task));
I := I + 1
end;
Lines.Add('');
Lines.Add('## Done');
I := 0;
while I < FTasks.Count do
begin
Task := TTask(FTasks.Get(I));
if Task.FStatus = tsDone then
Lines.Add(Self.FormatTask(Task));
I := I + 1
end;
Lines.SaveToFile(FFilePath);
FLastMtime := FileAge(FFilePath)
end;
@ -445,53 +429,49 @@ var
begin
Merged := 0;
DiskBoard := TBoard.Create(FFilePath);
try
DiskBoard.Load();
DiskBoard.Load();
MaxId := FNextId;
if DiskBoard.FNextId > MaxId then
MaxId := DiskBoard.FNextId;
MaxId := FNextId;
if DiskBoard.FNextId > MaxId then
MaxId := DiskBoard.FNextId;
I := 0;
while I < DiskBoard.FTasks.Count do
I := 0;
while I < DiskBoard.FTasks.Count do
begin
DiskTask := TTask(DiskBoard.FTasks.Get(I));
if Self.IsDeleted(DiskTask.FId) then
begin
DiskTask := TTask(DiskBoard.FTasks.Get(I));
if Self.IsDeleted(DiskTask.FId) then
begin
I := I + 1;
Continue
end;
MemTask := Self.FindById(DiskTask.FId);
if MemTask = nil then
begin
NewTask := TTask.Create();
NewTask.FId := DiskTask.FId;
NewTask.FTitle := DiskTask.FTitle;
NewTask.FStatus := DiskTask.FStatus;
NewTask.FCreated := DiskTask.FCreated;
NewTask.FPriority := DiskTask.FPriority;
FTasks.Add(NewTask);
Merged := Merged + 1
end
else if MemTask.FTitle <> DiskTask.FTitle then
begin
MemTask.FId := MaxId;
MaxId := MaxId + 1;
NewTask := TTask.Create();
NewTask.FId := DiskTask.FId;
NewTask.FTitle := DiskTask.FTitle;
NewTask.FStatus := DiskTask.FStatus;
NewTask.FCreated := DiskTask.FCreated;
NewTask.FPriority := DiskTask.FPriority;
FTasks.Add(NewTask);
Merged := Merged + 1
end;
I := I + 1
I := I + 1;
Continue
end;
FNextId := MaxId
finally
DiskBoard.Free()
MemTask := Self.FindById(DiskTask.FId);
if MemTask = nil then
begin
NewTask := TTask.Create();
NewTask.FId := DiskTask.FId;
NewTask.FTitle := DiskTask.FTitle;
NewTask.FStatus := DiskTask.FStatus;
NewTask.FCreated := DiskTask.FCreated;
NewTask.FPriority := DiskTask.FPriority;
FTasks.Add(NewTask);
Merged := Merged + 1
end
else if MemTask.FTitle <> DiskTask.FTitle then
begin
MemTask.FId := MaxId;
MaxId := MaxId + 1;
NewTask := TTask.Create();
NewTask.FId := DiskTask.FId;
NewTask.FTitle := DiskTask.FTitle;
NewTask.FStatus := DiskTask.FStatus;
NewTask.FCreated := DiskTask.FCreated;
NewTask.FPriority := DiskTask.FPriority;
FTasks.Add(NewTask);
Merged := Merged + 1
end;
I := I + 1
end;
FNextId := MaxId;
FLastMtime := FileAge(FFilePath);
Result := Merged
end;

36
tools/kanban/src/main/pascal/kanban.ui.pas
View file

@ -276,27 +276,23 @@ begin
else
begin
Lines := TStringList.Create();
try
Lines.Text := Content;
StartLine := FDetailScroll;
if StartLine > Lines.Count - 1 then
StartLine := Lines.Count - 1;
if StartLine < 0 then StartLine := 0;
Lines.Text := Content;
StartLine := FDetailScroll;
if StartLine > Lines.Count - 1 then
StartLine := Lines.Count - 1;
if StartLine < 0 then StartLine := 0;
I := StartLine;
Y := 4;
while (I < Lines.Count) and (Y <= FTerm.Rows - 2) do
begin
FTerm.MoveTo(Y, 2);
Line := Lines.Get(I);
if Length(Line) > FTerm.Cols - 3 then
Line := Copy(Line, 0, FTerm.Cols - 3);
FTerm.BufWrite(Line);
I := I + 1;
Y := Y + 1
end
finally
Lines.Free()
I := StartLine;
Y := 4;
while (I < Lines.Count) and (Y <= FTerm.Rows - 2) do
begin
FTerm.MoveTo(Y, 2);
Line := Lines.Get(I);
if Length(Line) > FTerm.Cols - 3 then
Line := Copy(Line, 0, FTerm.Cols - 3);
FTerm.BufWrite(Line);
I := I + 1;
Y := Y + 1
end
end;