From 676cee0caeae97bdfa326905064cf4ac39633582 Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Tue, 23 Jun 2026 19:21:09 +0100 Subject: [PATCH] Modernise stdlib testing + tools: TList over TStringList, drop .Free Showcase generics + ARC across the test framework and tools. Replace TStringList with TList 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. --- .../test/pascal/cp.test.runner_filters.pas | 58 ++--- stdlib/src/main/pascal/blaise.testing.pas | 26 +-- .../pascal/blaise.testing.runner.text.pas | 102 +++++---- .../src/main/pascal/BifCoverage.pas | 144 ++++--------- tools/kanban/src/main/pascal/kanban.data.pas | 200 ++++++++---------- tools/kanban/src/main/pascal/kanban.ui.pas | 36 ++-- 6 files changed, 239 insertions(+), 327 deletions(-) diff --git a/compiler/src/test/pascal/cp.test.runner_filters.pas b/compiler/src/test/pascal/cp.test.runner_filters.pas index 3e921b6..afc9601 100644 --- a/compiler/src/test/pascal/cp.test.runner_filters.pas +++ b/compiler/src/test/pascal/cp.test.runner_filters.pas @@ -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; begin - L := TStringList.Create(); + L := TList.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; begin - L := TStringList.Create(); + L := TList.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; begin - L := TStringList.Create(); + L := TList.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; begin - L := TStringList.Create(); + L := TList.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; begin - L := TStringList.Create(); + L := TList.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; begin - L := TStringList.Create(); + L := TList.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; begin - L := TStringList.Create(); + L := TList.Create(); L.Add('TFoo'); AssertFalse('other class', MatchesFilters(L, 'TBar', 'TestA')); end; procedure TRunnerFiltersTests.TestMatches_MethodFilterIsExact; -var L: TStringList; +var L: TList; begin - L := TStringList.Create(); + L := TList.Create(); L.Add('TFoo.TestBar'); AssertTrue('exact match', MatchesFilters(L, 'TFoo', 'TestBar')); end; procedure TRunnerFiltersTests.TestMatches_MethodFilterRejectsOtherMethod; -var L: TStringList; +var L: TList; begin - L := TStringList.Create(); + L := TList.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; begin - L := TStringList.Create(); + L := TList.Create(); L.Add('TFoo.TestA'); L.Add('TBar'); AssertTrue('first filter hits', diff --git a/stdlib/src/main/pascal/blaise.testing.pas b/stdlib/src/main/pascal/blaise.testing.pas index c00369c..ebcf3e8 100644 --- a/stdlib/src/main/pascal/blaise.testing.pas +++ b/stdlib/src/main/pascal/blaise.testing.pas @@ -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; + FErrorList: TList; 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 read FFailureList; + property Errors: TList 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.Create(); + Self.FErrorList := TList.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; diff --git a/stdlib/src/main/pascal/blaise.testing.runner.text.pas b/stdlib/src/main/pascal/blaise.testing.runner.text.pas index b0095b6..88ef95c 100644 --- a/stdlib/src/main/pascal/blaise.testing.runner.text.pas +++ b/stdlib/src/main/pascal/blaise.testing.runner.text.pas @@ -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 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; 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; 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; 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; 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; 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; 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; 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; + Errs: TList; 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; Verbose: Boolean; begin - Filters := TStringList.Create(); + Filters := TList.Create(); ParseArgs(Filters, Verbose); R := RunFilteredTests(Filters, Verbose); PrintSummary(R); diff --git a/tools/bif-coverage/src/main/pascal/BifCoverage.pas b/tools/bif-coverage/src/main/pascal/BifCoverage.pas index a3e2044..ead3489 100644 --- a/tools/bif-coverage/src/main/pascal/BifCoverage.pas +++ b/tools/bif-coverage/src/main/pascal/BifCoverage.pas @@ -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; var Stripped, Tok: string; P, Len: Integer; begin - Result := TStringList.Create; + Result := TList.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; 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); 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; 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; 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.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; 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; + MarkNames: TList; P, Len, Save: Integer; Tok: string; Blk: TIOBlock; I, EndPos, StartPos: Integer; begin - MarkPositions := TStringList.Create; - MarkNames := TStringList.Create; - try + MarkPositions := TList.Create; + MarkNames := TList.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; P, Len, I, EndPos, J, Q, StartPos: Integer; Block, Tok: string; Blk: TIOBlock; begin - Starts := TStringList.Create; - try + Starts := TList.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; I: Integer; InBlockComment, InImpl, InDecoder: Boolean; Body, Line, Trimmed: string; EncSB, DecSB: TStringBuilder; begin Raw := LoadLines(GIoFile); - Cleaned := TStringList.Create; + Cleaned := TList.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: . '); 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; 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.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. diff --git a/tools/kanban/src/main/pascal/kanban.data.pas b/tools/kanban/src/main/pascal/kanban.data.pas index 7e29824..0bf764d 100644 --- a/tools/kanban/src/main/pascal/kanban.data.pas +++ b/tools/kanban/src/main/pascal/kanban.data.pas @@ -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; diff --git a/tools/kanban/src/main/pascal/kanban.ui.pas b/tools/kanban/src/main/pascal/kanban.ui.pas index 6cec108..5c518c1 100644 --- a/tools/kanban/src/main/pascal/kanban.ui.pas +++ b/tools/kanban/src/main/pascal/kanban.ui.pas @@ -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;